* move utility code to a separate unit

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@40692 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 223 insertions, 197 deletions

diff --git a/packages/rtl-objpas/tests/tests.rtti.invoke.pas b/packages/rtl-objpas/tests/tests.rtti.invoke.pas
index 5b102caaa5..b3e063691a 100644
--- a/packages/rtl-objpas/tests/tests.rtti.invoke.pas
+++ b/packages/rtl-objpas/tests/tests.rtti.invoke.pas
@@ -14,13 +14,10 @@ uses
 {$ELSE FPC}
   TestFramework,
 {$ENDIF FPC}
-  sysutils, typinfo, Rtti;
+  sysutils, typinfo, Rtti,
+  Tests.Rtti.Util;
 
 type
-{$ifndef fpc}
-  CodePointer = Pointer;
-{$endif}
-
   TTestInvoke = class(TTestCase)
   private type
     TInvokeFlag = (
@@ -29,8 +26,6 @@ type
     );
     TInvokeFlags = set of TInvokeFlag;
   private
-    function EqualValues(aValue1, aValue2: TValue): Boolean;
-
     function DoInvoke(aCodeAddress: CodePointer; aArgs: TValueArray; aCallConv: TCallConv; aResultType: PTypeInfo; aFlags: TInvokeFlags; out aValid: Boolean): TValue;
     procedure DoStaticInvokeTestOrdinalCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; aResult: Int64);
     procedure DoStaticInvokeTestAnsiStringCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: AnsiString);
@@ -72,132 +67,8 @@ type
     procedure TestProcRecs;
   end;
 
-{$ifndef fpc}
-  TValueHelper = record helper for TValue
-    function AsUnicodeString: UnicodeString;
-    function AsAnsiString: AnsiString;
-  end;
-{$endif}
-
 implementation
 
-{$ifndef fpc}
-function TValueHelper.AsUnicodeString: UnicodeString;
-begin
-  Result := UnicodeString(AsString);
-end;
-
-function TValueHelper.AsAnsiString: AnsiString;
-begin
-  Result := AnsiString(AsString);
-end;
-{$endif}
-
-function TTestInvoke.EqualValues(aValue1, aValue2: TValue): Boolean;
-var
-  td1, td2: PTypeData;
-  i: SizeInt;
-begin
-{$ifdef debug}
-  Writeln('Empty: ', aValue1.IsEmpty, ' ', aValue2.IsEmpty);
-  Writeln('Kind: ', aValue1.Kind, ' ', aValue2.Kind);
-  Writeln('Array: ', aValue1.IsArray, ' ', aValue2.IsArray);
-{$endif}
-  if aValue1.IsEmpty and aValue2.IsEmpty then
-    Result := True
-  else if aValue1.IsEmpty and not aValue2.IsEmpty then
-    Result := False
-  else if not aValue1.IsEmpty and aValue2.IsEmpty then
-    Result := False
-  else if aValue1.IsArray and aValue2.IsArray then begin
-    if aValue1.GetArrayLength = aValue2.GetArrayLength then begin
-      Result := True;
-      for i := 0 to aValue1.GetArrayLength - 1 do
-        if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
-          Writeln('Element ', i, ' differs: ', HexStr(aValue1.GetArrayElement(i).AsOrdinal, 4), ' ', HexStr(aValue2.GetArrayElement(i).AsOrdinal, 4));
-          Result := False;
-          Break;
-        end;
-    end else
-      Result := False;
-  end else if aValue1.Kind = aValue2.Kind then begin
-    td1 := aValue1.TypeData;
-    td2 := aValue2.TypeData;
-    case aValue1.Kind of
-      tkBool:
-        Result := aValue1.AsBoolean xor not aValue2.AsBoolean;
-      tkSet:
-        if td1^.SetSize = td2^.SetSize then
-          if td1^.SetSize < SizeOf(SizeInt) then
-            Result := aValue1.AsOrdinal = aValue2.AsOrdinal
-          else
-            Result := CompareMem(aValue1.GetReferenceToRawData, aValue2.GetReferenceToRawData, td1^.SetSize)
-        else
-          Result := False;
-      tkEnumeration,
-      tkChar,
-      tkWChar,
-      tkUChar,
-      tkInt64,
-      tkInteger:
-        Result := aValue1.AsOrdinal = aValue2.AsOrdinal;
-      tkQWord:
-        Result := aValue1.AsUInt64 = aValue2.AsUInt64;
-      tkFloat:
-        if td1^.FloatType <> td2^.FloatType then
-          Result := False
-        else begin
-          case td1^.FloatType of
-            ftSingle,
-            ftDouble,
-            ftExtended:
-              Result := aValue1.AsExtended = aValue2.AsExtended;
-            ftComp:
-              Result := aValue1.AsInt64 = aValue2.AsInt64;
-            ftCurr:
-              Result := aValue1.AsCurrency = aValue2.AsCurrency;
-          end;
-        end;
-      tkSString,
-      tkUString,
-      tkAString,
-      tkWString:
-        Result := aValue1.AsString = aValue2.AsString;
-      tkDynArray,
-      tkArray:
-        if aValue1.GetArrayLength = aValue2.GetArrayLength then begin
-          Result := True;
-          for i := 0 to aValue1.GetArrayLength - 1 do
-            if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
-              Result := False;
-              Break;
-            end;
-        end else
-          Result := False;
-      tkClass,
-      tkClassRef,
-      tkInterface,
-      tkInterfaceRaw,
-      tkPointer:
-        Result := PPointer(aValue1.GetReferenceToRawData)^ = PPointer(aValue2.GetReferenceToRawData)^;
-      tkProcVar:
-        Result := PCodePointer(aValue1.GetReferenceToRawData)^ = PCodePointer(aValue2.GetReferenceToRawData)^;
-      tkRecord,
-      tkObject,
-      tkMethod,
-      tkVariant: begin
-        if aValue1.DataSize = aValue2.DataSize then
-          Result := CompareMem(aValue1.GetReferenceToRawData, aValue2.GetReferenceToRawData, aValue1.DataSize)
-        else
-          Result := False;
-      end
-      else
-        Result := False;
-    end;
-  end else
-    Result := False;
-end;
-
 function TTestInvoke.DoInvoke(aCodeAddress: CodePointer; aArgs: TValueArray;
   aCallConv: TCallConv; aResultType: PTypeInfo; aFlags: TInvokeFlags; out aValid: Boolean): TValue;
 begin
@@ -1616,24 +1487,6 @@ begin
   Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1);
 end;
 
-function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
-var
-  arrptr: Pointer;
-  len, i: SizeInt;
-begin
-  if aValue.Kind = tkDynArray then begin
-    { we need to decouple the source reference, so we're going to be a bit
-      cheeky here }
-    len := aValue.GetArrayLength;
-    arrptr := Nil;
-    DynArraySetLength(arrptr, aValue.TypeInfo, 1, @len);
-    TValue.Make(@arrptr, aValue.TypeInfo, Result);
-    for i := 0 to len - 1 do
-      Result.SetArrayElement(i, aValue.GetArrayElement(i));
-  end else
-    TValue.Make(aValue.GetReferenceToRawData, aValue.TypeInfo, Result);
-end;
-
 procedure TTestInvoke.DoIntfInvoke(aIndex: SizeInt; aInputArgs,
   aOutputArgs: TValueArray; aResult: TValue);
 var
@@ -1899,54 +1752,6 @@ begin
 end;
 {$endif}
 
-function GetIntValue(aValue: SizeInt): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<SizeInt>(aValue);
-end;
-
-function GetAnsiString(const aValue: AnsiString): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>(aValue);
-end;
-
-function GetShortString(const aValue: ShortString): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<ShortString>(aValue);
-end;
-
-function GetSingleValue(aValue: Single): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<Single>(aValue);
-end;
-
-function GetDoubleValue(aValue: Double): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<Double>(aValue);
-end;
-
-function GetExtendedValue(aValue: Extended): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<Extended>(aValue);
-end;
-
-function GetCompValue(aValue: Comp): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<Comp>(aValue);
-end;
-
-function GetCurrencyValue(aValue: Currency): TValue;
-begin
-  Result := TValue.{$ifdef fpc}specialize{$endif}From<Currency>(aValue);
-end;
-
-
-{$ifdef fpc}
-function GetArray(const aArg: array of SizeInt): TValue;
-begin
-  Result := specialize OpenArrayToDynArrayValue<SizeInt>(aArg);
-end;
-{$endif}
-
 procedure TTestInvoke.TestIntfMethods;
 begin
   DoIntfInvoke(1, [], [], TValue.Empty);
diff --git a/packages/rtl-objpas/tests/tests.rtti.util.pas b/packages/rtl-objpas/tests/tests.rtti.util.pas
new file mode 100644
index 0000000000..5f9899478c
--- /dev/null
+++ b/packages/rtl-objpas/tests/tests.rtti.util.pas
@@ -0,0 +1,221 @@
+unit Tests.Rtti.Util;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Rtti;
+
+{$ifndef fpc}
+type
+  CodePointer = Pointer;
+
+  TValueHelper = record helper for TValue
+    function AsUnicodeString: UnicodeString;
+    function AsAnsiString: AnsiString;
+  end;
+{$endif}
+
+function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
+function EqualValues({$ifdef fpc}constref{$else}const [ref]{$endif} aValue1, aValue2: TValue): Boolean;
+
+function GetIntValue(aValue: SizeInt): TValue;
+function GetAnsiString(const aValue: AnsiString): TValue;
+function GetShortString(const aValue: ShortString): TValue;
+function GetSingleValue(aValue: Single): TValue;
+function GetDoubleValue(aValue: Double): TValue;
+function GetExtendedValue(aValue: Extended): TValue;
+function GetCompValue(aValue: Comp): TValue;
+function GetCurrencyValue(aValue: Currency): TValue;
+function GetArray(const aArg: array of SizeInt): TValue;
+
+implementation
+
+uses
+  TypInfo, SysUtils;
+
+{$ifndef fpc}
+function TValueHelper.AsUnicodeString: UnicodeString;
+begin
+  Result := UnicodeString(AsString);
+end;
+
+function TValueHelper.AsAnsiString: AnsiString;
+begin
+  Result := AnsiString(AsString);
+end;
+{$endif}
+
+function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
+var
+  arrptr: Pointer;
+  len, i: SizeInt;
+begin
+  if aValue.Kind = tkDynArray then begin
+    { we need to decouple the source reference, so we're going to be a bit
+      cheeky here }
+    len := aValue.GetArrayLength;
+    arrptr := Nil;
+    DynArraySetLength(arrptr, aValue.TypeInfo, 1, @len);
+    TValue.Make(@arrptr, aValue.TypeInfo, Result);
+    for i := 0 to len - 1 do
+      Result.SetArrayElement(i, aValue.GetArrayElement(i));
+  end else
+    TValue.Make(aValue.GetReferenceToRawData, aValue.TypeInfo, Result);
+end;
+
+function EqualValues({$ifdef fpc}constref{$else}const [ref]{$endif} aValue1, aValue2: TValue): Boolean;
+var
+  td1, td2: PTypeData;
+  i: SizeInt;
+begin
+{$ifdef debug}
+  Writeln('Empty: ', aValue1.IsEmpty, ' ', aValue2.IsEmpty);
+  Writeln('Kind: ', aValue1.Kind, ' ', aValue2.Kind);
+  Writeln('Array: ', aValue1.IsArray, ' ', aValue2.IsArray);
+{$endif}
+  if aValue1.IsEmpty and aValue2.IsEmpty then
+    Result := True
+  else if aValue1.IsEmpty and not aValue2.IsEmpty then
+    Result := False
+  else if not aValue1.IsEmpty and aValue2.IsEmpty then
+    Result := False
+  else if aValue1.IsArray and aValue2.IsArray then begin
+    if aValue1.GetArrayLength = aValue2.GetArrayLength then begin
+      Result := True;
+      for i := 0 to aValue1.GetArrayLength - 1 do
+        if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
+          Writeln('Element ', i, ' differs: ', HexStr(aValue1.GetArrayElement(i).AsOrdinal, 4), ' ', HexStr(aValue2.GetArrayElement(i).AsOrdinal, 4));
+          Result := False;
+          Break;
+        end;
+    end else
+      Result := False;
+  end else if aValue1.Kind = aValue2.Kind then begin
+    td1 := aValue1.TypeData;
+    td2 := aValue2.TypeData;
+    case aValue1.Kind of
+      tkBool:
+        Result := aValue1.AsBoolean xor not aValue2.AsBoolean;
+      tkSet:
+        if td1^.SetSize = td2^.SetSize then
+          if td1^.SetSize < SizeOf(SizeInt) then
+            Result := aValue1.AsOrdinal = aValue2.AsOrdinal
+          else
+            Result := CompareMem(aValue1.GetReferenceToRawData, aValue2.GetReferenceToRawData, td1^.SetSize)
+        else
+          Result := False;
+      tkEnumeration,
+      tkChar,
+      tkWChar,
+      tkUChar,
+      tkInt64,
+      tkInteger:
+        Result := aValue1.AsOrdinal = aValue2.AsOrdinal;
+      tkQWord:
+        Result := aValue1.AsUInt64 = aValue2.AsUInt64;
+      tkFloat:
+        if td1^.FloatType <> td2^.FloatType then
+          Result := False
+        else begin
+          case td1^.FloatType of
+            ftSingle,
+            ftDouble,
+            ftExtended:
+              Result := aValue1.AsExtended = aValue2.AsExtended;
+            ftComp:
+              Result := aValue1.AsInt64 = aValue2.AsInt64;
+            ftCurr:
+              Result := aValue1.AsCurrency = aValue2.AsCurrency;
+          end;
+        end;
+      tkSString,
+      tkUString,
+      tkAString,
+      tkWString:
+        Result := aValue1.AsString = aValue2.AsString;
+      tkDynArray,
+      tkArray:
+        if aValue1.GetArrayLength = aValue2.GetArrayLength then begin
+          Result := True;
+          for i := 0 to aValue1.GetArrayLength - 1 do
+            if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
+              Result := False;
+              Break;
+            end;
+        end else
+          Result := False;
+      tkClass,
+      tkClassRef,
+      tkInterface,
+      tkInterfaceRaw,
+      tkPointer:
+        Result := PPointer(aValue1.GetReferenceToRawData)^ = PPointer(aValue2.GetReferenceToRawData)^;
+      tkProcVar:
+        Result := PCodePointer(aValue1.GetReferenceToRawData)^ = PCodePointer(aValue2.GetReferenceToRawData)^;
+      tkRecord,
+      tkObject,
+      tkMethod,
+      tkVariant: begin
+        if aValue1.DataSize = aValue2.DataSize then
+          Result := CompareMem(aValue1.GetReferenceToRawData, aValue2.GetReferenceToRawData, aValue1.DataSize)
+        else
+          Result := False;
+      end
+      else
+        Result := False;
+    end;
+  end else
+    Result := False;
+end;
+
+function GetIntValue(aValue: SizeInt): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<SizeInt>(aValue);
+end;
+
+function GetAnsiString(const aValue: AnsiString): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>(aValue);
+end;
+
+function GetShortString(const aValue: ShortString): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<ShortString>(aValue);
+end;
+
+function GetSingleValue(aValue: Single): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<Single>(aValue);
+end;
+
+function GetDoubleValue(aValue: Double): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<Double>(aValue);
+end;
+
+function GetExtendedValue(aValue: Extended): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<Extended>(aValue);
+end;
+
+function GetCompValue(aValue: Comp): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<Comp>(aValue);
+end;
+
+function GetCurrencyValue(aValue: Currency): TValue;
+begin
+  Result := TValue.{$ifdef fpc}specialize{$endif}From<Currency>(aValue);
+end;
+
+{$ifdef fpc}
+function GetArray(const aArg: array of SizeInt): TValue;
+begin
+  Result := specialize OpenArrayToDynArrayValue<SizeInt>(aArg);
+end;
+{$endif}
+
+end.
+