paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 01:39:27 +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
PBoolean16 = ^Boolean16;
PBoolean32 = ^Boolean32;
PBoolean64 = ^Boolean64;
PByteBool = ^ByteBool;
PQWordBool = ^QWordBool;
begin
result.FData.FTypeInfo:=ATypeInfo;
case ATypeInfo^.Kind of
tkSString : result.FData.FValueData := TValueDataIntImpl.Create(@PShortString(ABuffer)^[1],Length(PShortString(ABuffer)^));
tkAString : result.FData.FValueData := TValueDataIntImpl.Create(@PAnsiString(ABuffer)^[1],length(PAnsiString(ABuffer)^));
tkClass : result.FData.FAsObject := PPointer(ABuffer)^;
tkInt64,
tkQWord : result.FData.FAsSInt64 := PInt64(ABuffer)^;
tkInt64 : result.FData.FAsSInt64 := PInt64(ABuffer)^;
tkQWord : result.FData.FAsUInt64 := PQWord(ABuffer)^;
tkInteger : begin
case GetTypeData(ATypeInfo)^.OrdType of
otSByte, otUByte: result.FData.FAsSInt64 := Int64(PByte(ABuffer)^);
otSWord, otUWord: result.FData.FAsSInt64 := Int64(PWord(ABuffer)^);
otSLong, otULong: result.FData.FAsSInt64 := Int64(PLongWord(ABuffer)^);
otSByte: result.FData.FAsSByte := PShortInt(ABuffer)^;
otUByte: result.FData.FAsUByte := PByte(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;
tkBool : begin
case GetTypeData(ATypeInfo)^.OrdType of
otUByte: result.FData.FAsSInt64 := Int64(PBoolean(ABuffer)^);
otUWord: result.FData.FAsSInt64 := Int64(PBoolean16(ABuffer)^);
otULong: result.FData.FAsSInt64 := Int64(PBoolean32(ABuffer)^);
otSByte: result.FData.FAsSInt64 := Int64(PByteBool(ABuffer)^);
otSWord: result.FData.FAsSInt64 := Int64(PWordBool(ABuffer)^);
otSLong: result.FData.FAsSInt64 := Int64(PLongBool(ABuffer)^);
otUByte: result.FData.FAsSByte := ShortInt(PBoolean(ABuffer)^);
otUWord: result.FData.FAsUWord := Byte(PBoolean16(ABuffer)^);
otULong: result.FData.FAsULong := SmallInt(PBoolean32(ABuffer)^);
otUQWord: result.FData.FAsUInt64 := QWord(PBoolean64(ABuffer)^);
otSByte: result.FData.FAsSByte := Word(PByteBool(ABuffer)^);
otSWord: result.FData.FAsSWord := LongInt(PWordBool(ABuffer)^);
otSLong: result.FData.FAsSLong := LongWord(PLongBool(ABuffer)^);
otSQWord: result.FData.FAsSInt64 := Int64(PQWordBool(ABuffer)^);
end;
end;
tkFloat : begin
@ -600,7 +607,16 @@ end;
function TValue.AsBoolean: boolean;
begin
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
raise EInvalidCast.Create(SErrInvalidTypecast);
end;
@ -608,7 +624,16 @@ end;
function TValue.AsOrdinal: int64;
begin
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
raise EInvalidCast.Create(SErrInvalidTypecast);
end;
@ -623,8 +648,17 @@ end;
function TValue.AsInteger: Integer;
begin
if Kind in [tkInteger, tkInt64] then
result := integer(FData.FAsSInt64)
if Kind in [tkInteger, tkInt64, tkQWord] then
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
raise EInvalidCast.Create(SErrInvalidTypecast);
end;