Browse Source

* partial fix for Mantis #36356: apply partial, adjusted patch by Imants Gulbis to add methods for TValue to retrieve a AnsiChar or WideChar (this is not Delphi compatible, but convenient)

git-svn-id: trunk@43779 -
svenbarth 5 years ago
parent
commit
be1439e93e

+ 28 - 0
packages/rtl-objpas/src/inc/rtti.pp

@@ -136,6 +136,9 @@ type
     function AsBoolean: boolean;
     function AsCurrency: Currency;
     function AsInteger: Integer;
+    function AsChar: Char; inline;
+    function AsAnsiChar: AnsiChar;
+    function AsWideChar: WideChar;
     function AsInt64: Int64;
     function AsUInt64: QWord;
     function AsInterface: IInterface;
@@ -1948,6 +1951,31 @@ begin
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsAnsiChar: AnsiChar;
+begin
+  if Kind = tkChar then
+    Result := Chr(FData.FAsUByte)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsWideChar: WideChar;
+begin
+  if Kind = tkWChar then
+    Result := WideChar(FData.FAsUWord)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsChar: Char;
+begin
+{$if SizeOf(Char) = 1}
+  Result := AsAnsiChar;
+{$else}
+  Result := AsWideChar;
+{$endif}
+end;
+
 function TValue.AsInt64: Int64;
 begin
   if Kind in [tkInteger, tkInt64, tkQWord] then

+ 2 - 0
packages/rtl-objpas/tests/tests.rtti.pas

@@ -718,6 +718,7 @@ begin
 
   Check(v.GetReferenceToRawData <> @c);
   Check(AnsiChar(v.AsOrdinal) = #20);
+  Check(v.AsAnsiChar = #20);
 end;
 
 procedure TTestCase1.TestMakeWideChar;
@@ -737,6 +738,7 @@ begin
 
   Check(v.GetReferenceToRawData <> @c);
   Check(WideChar(v.AsOrdinal) = #$1234);
+  Check(v.AsWideChar = #$1234);
 end;
 
 procedure TTestCase1.MakeFromOrdinalTObject;

+ 22 - 0
packages/rtl-objpas/tests/tests.rtti.util.pas

@@ -14,6 +14,9 @@ type
   TValueHelper = record helper for TValue
     function AsUnicodeString: UnicodeString;
     function AsAnsiString: AnsiString;
+    function AsChar: Char; inline;
+    function AsAnsiChar: AnsiChar;
+    function AsWideChar: WideChar;
   end;
 {$endif}
 
@@ -56,6 +59,25 @@ function TValueHelper.AsAnsiString: AnsiString;
 begin
   Result := AnsiString(AsString);
 end;
+
+function TValue.AsWideChar: WideChar;
+begin
+  if Kind <> tkWideChar then
+    raise EInvalidCast.Create('Invalid cast');
+  Result := WideChar(Word(AsOrdinal));
+end;
+
+function TValue.AsAnsiChar: AnsiChar;
+begin
+  if Kind <> tkChar then
+    raise EInvalidCast.Create('Invalid cast');
+  Result := AnsiChar(Byte(AsOrdinal));
+end;
+
+function TValue.AsChar: Char;
+begin
+  Result := AsWideChar;
+end;
 {$endif}
 
 function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;