mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 05:06:03 +02:00
* fix for Mantis #35693: IsOrdinal also needs to return true for enums (with that AsOrdinal will work correctly as well)
* extended RTTI test by a test for enums git-svn-id: trunk@42219 -
This commit is contained in:
parent
d1830fc589
commit
a2a403e2e5
@ -1548,7 +1548,7 @@ end;
|
|||||||
|
|
||||||
function TValue.IsOrdinal: boolean;
|
function TValue.IsOrdinal: boolean;
|
||||||
begin
|
begin
|
||||||
result := (Kind in [tkInteger, tkInt64, tkQWord, tkBool]) or
|
result := (Kind in [tkInteger, tkInt64, tkQWord, tkBool, tkEnumeration]) or
|
||||||
((Kind in [tkClass, tkClassRef, tkInterfaceRaw, tkUnknown]) and not Assigned(FData.FAsPointer));
|
((Kind in [tkClass, tkClassRef, tkInterfaceRaw, tkUnknown]) and not Assigned(FData.FAsPointer));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -60,6 +60,7 @@ type
|
|||||||
procedure TestMakeExtended;
|
procedure TestMakeExtended;
|
||||||
procedure TestMakeCurrency;
|
procedure TestMakeCurrency;
|
||||||
procedure TestMakeComp;
|
procedure TestMakeComp;
|
||||||
|
procedure TestMakeEnum;
|
||||||
|
|
||||||
procedure TestDataSize;
|
procedure TestDataSize;
|
||||||
procedure TestDataSizeEmpty;
|
procedure TestDataSizeEmpty;
|
||||||
@ -665,6 +666,25 @@ begin
|
|||||||
CheckFalse(hadexcept, 'Had unsigned type conversion exception');
|
CheckFalse(hadexcept, 'Had unsigned type conversion exception');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestCase1.TestMakeEnum;
|
||||||
|
var
|
||||||
|
e: TTestEnum;
|
||||||
|
v: TValue;
|
||||||
|
begin
|
||||||
|
e := te1;
|
||||||
|
|
||||||
|
TValue.Make(@e, TypeInfo(e), v);
|
||||||
|
Check(not v.IsClass);
|
||||||
|
Check(not v.IsArray);
|
||||||
|
Check(not v.IsEmpty);
|
||||||
|
Check(not v.IsOpenArray);
|
||||||
|
Check(not v.IsObject);
|
||||||
|
Check(v.IsOrdinal);
|
||||||
|
|
||||||
|
Check(v.GetReferenceToRawData <> @e);
|
||||||
|
Check(TTestEnum(v.AsOrdinal) = te1);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTestCase1.TestGetIsReadable;
|
procedure TTestCase1.TestGetIsReadable;
|
||||||
var
|
var
|
||||||
c: TRttiContext;
|
c: TRttiContext;
|
||||||
|
Loading…
Reference in New Issue
Block a user