mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-31 19:10:26 +02:00
* correctly handle both Ansi- and WideChar in TValue
+ added tests git-svn-id: trunk@42220 -
This commit is contained in:
parent
a2a403e2e5
commit
34569080be
@ -1371,6 +1371,9 @@ begin
|
||||
raise Exception.CreateFmt(SErrUnableToGetValueForType,[ATypeInfo^.Name]);
|
||||
end;
|
||||
end;
|
||||
tkChar,
|
||||
tkWChar,
|
||||
tkUChar,
|
||||
tkEnumeration,
|
||||
tkInteger : begin
|
||||
case GetTypeData(ATypeInfo)^.OrdType of
|
||||
@ -1548,7 +1551,7 @@ end;
|
||||
|
||||
function TValue.IsOrdinal: boolean;
|
||||
begin
|
||||
result := (Kind in [tkInteger, tkInt64, tkQWord, tkBool, tkEnumeration]) or
|
||||
result := (Kind in [tkInteger, tkInt64, tkQWord, tkBool, tkEnumeration, tkChar, tkWChar, tkUChar]) or
|
||||
((Kind in [tkClass, tkClassRef, tkInterfaceRaw, tkUnknown]) and not Assigned(FData.FAsPointer));
|
||||
end;
|
||||
|
||||
|
@ -61,6 +61,8 @@ type
|
||||
procedure TestMakeCurrency;
|
||||
procedure TestMakeComp;
|
||||
procedure TestMakeEnum;
|
||||
procedure TestMakeAnsiChar;
|
||||
procedure TestMakeWideChar;
|
||||
|
||||
procedure TestDataSize;
|
||||
procedure TestDataSizeEmpty;
|
||||
@ -685,6 +687,44 @@ begin
|
||||
Check(TTestEnum(v.AsOrdinal) = te1);
|
||||
end;
|
||||
|
||||
procedure TTestCase1.TestMakeAnsiChar;
|
||||
var
|
||||
c: AnsiChar;
|
||||
v: TValue;
|
||||
begin
|
||||
c := #20;
|
||||
|
||||
TValue.Make(@c, TypeInfo(c), 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 <> @c);
|
||||
Check(AnsiChar(v.AsOrdinal) = #20);
|
||||
end;
|
||||
|
||||
procedure TTestCase1.TestMakeWideChar;
|
||||
var
|
||||
c: WideChar;
|
||||
v: TValue;
|
||||
begin
|
||||
c := #$1234;
|
||||
|
||||
TValue.Make(@c, TypeInfo(c), 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 <> @c);
|
||||
Check(WideChar(v.AsOrdinal) = #$1234);
|
||||
end;
|
||||
|
||||
procedure TTestCase1.TestGetIsReadable;
|
||||
var
|
||||
c: TRttiContext;
|
||||
|
Loading…
Reference in New Issue
Block a user