mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-31 03:11:00 +02:00
* fixed tbinaryobjectwrite.writeset/readset on big endian systems
(and made it future proof in case the set format should change again, as long as the size of all streamed sets is guaranteed to be 4 bytes and if their packset setting is guaranteed to be 0). git-svn-id: trunk@11149 -
This commit is contained in:
parent
355c4c7c53
commit
b6a8e4343d
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7716,6 +7716,7 @@ tests/test/uinline4b.pp svneol=native#text/plain
|
||||
tests/test/umacpas1.pp svneol=native#text/plain
|
||||
tests/test/umainnam.pp svneol=native#text/plain
|
||||
tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
|
||||
tests/test/units/classes/tsetstream.pp svneol=native#text/plain
|
||||
tests/test/units/crt/tcrt.pp svneol=native#text/plain
|
||||
tests/test/units/crt/tctrlc.pp svneol=native#text/plain
|
||||
tests/test/units/dos/hello.pp svneol=native#text/plain
|
||||
|
@ -253,6 +253,8 @@ begin
|
||||
end;
|
||||
|
||||
function TBinaryObjectReader.ReadSet(EnumType: Pointer): Integer;
|
||||
type
|
||||
tset = set of 0..31;
|
||||
var
|
||||
Name: String;
|
||||
Value: Integer;
|
||||
@ -267,7 +269,7 @@ begin
|
||||
Value := GetEnumValue(PTypeInfo(EnumType), Name);
|
||||
if Value = -1 then
|
||||
raise EReadError.Create(SInvalidPropertyValue);
|
||||
Result := Result or (1 shl Value);
|
||||
include(tset(result),Value);
|
||||
end;
|
||||
except
|
||||
SkipSetBody;
|
||||
|
@ -259,17 +259,16 @@ begin
|
||||
end;
|
||||
|
||||
procedure TBinaryObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
|
||||
type
|
||||
tset = set of 0..31;
|
||||
var
|
||||
i: Integer;
|
||||
Mask: LongInt;
|
||||
begin
|
||||
WriteValue(vaSet);
|
||||
Mask := 1;
|
||||
for i := 0 to 31 do
|
||||
begin
|
||||
if (Value and Mask) <> 0 then
|
||||
if (i in tset(Value)) then
|
||||
WriteStr(GetEnumName(PTypeInfo(SetType), i));
|
||||
Mask := Mask shl 1;
|
||||
end;
|
||||
WriteStr('');
|
||||
end;
|
||||
|
53
tests/test/units/classes/tsetstream.pp
Normal file
53
tests/test/units/classes/tsetstream.pp
Normal file
@ -0,0 +1,53 @@
|
||||
program storedfalse;
|
||||
{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif}
|
||||
{$ifdef mswindows}{$apptype console}{$endif}
|
||||
uses
|
||||
{$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
|
||||
sysutils,classes;
|
||||
|
||||
type
|
||||
tenum = (eena,eenb,eenc,eend,eene,eenf,eeng,eenh,eeni);
|
||||
tset = set of tenum;
|
||||
|
||||
ttestclass1 = class(tcomponent)
|
||||
private
|
||||
fprop1: tset;
|
||||
public
|
||||
property prop1: tset read fprop1 write fprop1 stored true;
|
||||
end;
|
||||
|
||||
ttestclass2 = class(ttestclass1)
|
||||
published
|
||||
property prop1;
|
||||
end;
|
||||
|
||||
var
|
||||
testclass2,testclass3: ttestclass2;
|
||||
stream1,stream2: tmemorystream;
|
||||
str1: ansistring;
|
||||
begin
|
||||
testclass2:= ttestclass2.create(nil);
|
||||
testclass2.prop1:= [eenb,eend,eene,eenh,eeni];
|
||||
stream1:= tmemorystream.create;
|
||||
try
|
||||
stream1.writecomponent(testclass2);
|
||||
stream2:= tmemorystream.create;
|
||||
try
|
||||
stream1.position:= 0;
|
||||
objectbinarytotext(stream1,stream2);
|
||||
stream1.position:= 0;
|
||||
stream2.position:= 0;
|
||||
setlength(str1,stream2.size);
|
||||
move(stream2.memory^,str1[1],length(str1));
|
||||
writeln(str1);
|
||||
testclass3:=ttestclass2.create(nil);
|
||||
stream1.readcomponent(testclass3);
|
||||
if (testclass3.prop1<>[eenb,eend,eene,eenh,eeni]) then
|
||||
halt(1);
|
||||
finally
|
||||
stream2.free;
|
||||
end;
|
||||
finally
|
||||
stream1.free;
|
||||
end;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user