mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 21:10:14 +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]);
|
raise Exception.CreateFmt(SErrUnableToGetValueForType,[ATypeInfo^.Name]);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
tkChar,
|
||||||
|
tkWChar,
|
||||||
|
tkUChar,
|
||||||
tkEnumeration,
|
tkEnumeration,
|
||||||
tkInteger : begin
|
tkInteger : begin
|
||||||
case GetTypeData(ATypeInfo)^.OrdType of
|
case GetTypeData(ATypeInfo)^.OrdType of
|
||||||
@ -1548,7 +1551,7 @@ end;
|
|||||||
|
|
||||||
function TValue.IsOrdinal: boolean;
|
function TValue.IsOrdinal: boolean;
|
||||||
begin
|
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));
|
((Kind in [tkClass, tkClassRef, tkInterfaceRaw, tkUnknown]) and not Assigned(FData.FAsPointer));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -61,6 +61,8 @@ type
|
|||||||
procedure TestMakeCurrency;
|
procedure TestMakeCurrency;
|
||||||
procedure TestMakeComp;
|
procedure TestMakeComp;
|
||||||
procedure TestMakeEnum;
|
procedure TestMakeEnum;
|
||||||
|
procedure TestMakeAnsiChar;
|
||||||
|
procedure TestMakeWideChar;
|
||||||
|
|
||||||
procedure TestDataSize;
|
procedure TestDataSize;
|
||||||
procedure TestDataSizeEmpty;
|
procedure TestDataSizeEmpty;
|
||||||
@ -685,6 +687,44 @@ begin
|
|||||||
Check(TTestEnum(v.AsOrdinal) = te1);
|
Check(TTestEnum(v.AsOrdinal) = te1);
|
||||||
end;
|
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;
|
procedure TTestCase1.TestGetIsReadable;
|
||||||
var
|
var
|
||||||
c: TRttiContext;
|
c: TRttiContext;
|
||||||
|
Loading…
Reference in New Issue
Block a user