paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 20:29:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* correctly handle ordinals of different sizes

Browse Source 
git-svn-id: trunk@36907 -
This commit is contained in:
svenbarth 2017-08-14 20:28:01 +00:00
parent 56459594c0
commit 9a7d26e349
1 changed files with 49 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -472,30 +472,37 @@ class procedure TValue.Make(ABuffer: pointer; ATypeInfo: PTypeInfo; out result:
type type
PBoolean16 = ^Boolean16; PBoolean16 = ^Boolean16;
PBoolean32 = ^Boolean32; PBoolean32 = ^Boolean32;
PBoolean64 = ^Boolean64;
PByteBool = ^ByteBool; PByteBool = ^ByteBool;
PQWordBool = ^QWordBool;
begin begin
result.FData.FTypeInfo:=ATypeInfo; result.FData.FTypeInfo:=ATypeInfo;
case ATypeInfo^.Kind of case ATypeInfo^.Kind of
tkSString : result.FData.FValueData := TValueDataIntImpl.Create(@PShortString(ABuffer)^[1],Length(PShortString(ABuffer)^)); tkSString : result.FData.FValueData := TValueDataIntImpl.Create(@PShortString(ABuffer)^[1],Length(PShortString(ABuffer)^));
tkAString : result.FData.FValueData := TValueDataIntImpl.Create(@PAnsiString(ABuffer)^[1],length(PAnsiString(ABuffer)^)); tkAString : result.FData.FValueData := TValueDataIntImpl.Create(@PAnsiString(ABuffer)^[1],length(PAnsiString(ABuffer)^));
tkClass : result.FData.FAsObject := PPointer(ABuffer)^; tkClass : result.FData.FAsObject := PPointer(ABuffer)^;
tkInt64, tkInt64 : result.FData.FAsSInt64 := PInt64(ABuffer)^;
tkQWord : result.FData.FAsSInt64 := PInt64(ABuffer)^; tkQWord : result.FData.FAsUInt64 := PQWord(ABuffer)^;
tkInteger : begin tkInteger : begin
case GetTypeData(ATypeInfo)^.OrdType of case GetTypeData(ATypeInfo)^.OrdType of
otSByte, otUByte: result.FData.FAsSInt64 := Int64(PByte(ABuffer)^); otSByte: result.FData.FAsSByte := PShortInt(ABuffer)^;
otSWord, otUWord: result.FData.FAsSInt64 := Int64(PWord(ABuffer)^); otUByte: result.FData.FAsUByte := PByte(ABuffer)^;
otSLong, otULong: result.FData.FAsSInt64 := Int64(PLongWord(ABuffer)^); otSWord: result.FData.FAsSWord := PSmallInt(ABuffer)^;
otUWord: result.FData.FAsUWord := PWord(ABuffer)^;
otSLong: result.FData.FAsSLong := PLongInt(ABuffer)^;
otULong: result.FData.FAsULong := PLongWord(ABuffer)^;
end; end;
end; end;
tkBool : begin tkBool : begin
case GetTypeData(ATypeInfo)^.OrdType of case GetTypeData(ATypeInfo)^.OrdType of
otUByte: result.FData.FAsSInt64 := Int64(PBoolean(ABuffer)^); otUByte: result.FData.FAsSByte := ShortInt(PBoolean(ABuffer)^);
otUWord: result.FData.FAsSInt64 := Int64(PBoolean16(ABuffer)^); otUWord: result.FData.FAsUWord := Byte(PBoolean16(ABuffer)^);
otULong: result.FData.FAsSInt64 := Int64(PBoolean32(ABuffer)^); otULong: result.FData.FAsULong := SmallInt(PBoolean32(ABuffer)^);
otSByte: result.FData.FAsSInt64 := Int64(PByteBool(ABuffer)^); otUQWord: result.FData.FAsUInt64 := QWord(PBoolean64(ABuffer)^);
otSWord: result.FData.FAsSInt64 := Int64(PWordBool(ABuffer)^); otSByte: result.FData.FAsSByte := Word(PByteBool(ABuffer)^);
otSLong: result.FData.FAsSInt64 := Int64(PLongBool(ABuffer)^); otSWord: result.FData.FAsSWord := LongInt(PWordBool(ABuffer)^);
otSLong: result.FData.FAsSLong := LongWord(PLongBool(ABuffer)^);
otSQWord: result.FData.FAsSInt64 := Int64(PQWordBool(ABuffer)^);
end; end;
end; end;
tkFloat : begin tkFloat : begin
@ -600,7 +607,16 @@ end;
function TValue.AsBoolean: boolean; function TValue.AsBoolean: boolean;
begin begin
if (Kind = tkBool) then if (Kind = tkBool) then
result := boolean(FData.FAsSInt64) case TypeData^.OrdType of
otSByte: Result := ByteBool(FData.FAsSByte);
otUByte: Result := Boolean(FData.FAsUByte);
otSWord: Result := WordBool(FData.FAsSWord);
otUWord: Result := Boolean16(FData.FAsUWord);
otSLong: Result := LongBool(FData.FAsSLong);
otULong: Result := Boolean32(FData.FAsULong);
otSQWord: Result := QWordBool(FData.FAsSInt64);
otUQWord: Result := Boolean64(FData.FAsUInt64);
end
else else
raise EInvalidCast.Create(SErrInvalidTypecast); raise EInvalidCast.Create(SErrInvalidTypecast);
end; end;
@ -608,7 +624,16 @@ end;
function TValue.AsOrdinal: int64; function TValue.AsOrdinal: int64;
begin begin
if IsOrdinal then if IsOrdinal then
result := FData.FAsSInt64 case TypeData^.OrdType of
otSByte: Result := FData.FAsSByte;
otUByte: Result := FData.FAsUByte;
otSWord: Result := FData.FAsSWord;
otUWord: Result := FData.FAsUWord;
otSLong: Result := FData.FAsSLong;
otULong: Result := FData.FAsULong;
otSQWord: Result := FData.FAsSInt64;
otUQWord: Result := FData.FAsUInt64;
end
else else
raise EInvalidCast.Create(SErrInvalidTypecast); raise EInvalidCast.Create(SErrInvalidTypecast);
end; end;
@ -623,8 +648,17 @@ end;
function TValue.AsInteger: Integer; function TValue.AsInteger: Integer;
begin begin
if Kind in [tkInteger, tkInt64] then if Kind in [tkInteger, tkInt64, tkQWord] then
result := integer(FData.FAsSInt64) case TypeData^.OrdType of
otSByte: Result := FData.FAsSByte;
otUByte: Result := FData.FAsUByte;
otSWord: Result := FData.FAsSWord;
otUWord: Result := FData.FAsUWord;
otSLong: Result := FData.FAsSLong;
otULong: Result := FData.FAsULong;
otSQWord: Result := FData.FAsSInt64;
otUQWord: Result := FData.FAsUInt64;
end
else else
raise EInvalidCast.Create(SErrInvalidTypecast); raise EInvalidCast.Create(SErrInvalidTypecast);
end; end;