|
@@ -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);
|
|
@@ -38,9 +33,11 @@ type
|
|
|
procedure DoIntfInvoke(aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
procedure DoMethodInvoke(aInst: TObject; aMethod: TMethod; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
procedure DoProcVarInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
+ procedure DoProcInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
{$ifndef InLazIDE}
|
|
|
{$ifdef fpc}generic{$endif} procedure GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
{$ifdef fpc}generic{$endif} procedure GenDoProcvarInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
+ {$ifdef fpc}generic{$endif} procedure GenDoProcInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
{$ifdef fpc}generic{$endif} function GetRecValue<T>(aReverse: Boolean): TValue;
|
|
|
{$endif}
|
|
|
{$ifdef fpc}
|
|
@@ -65,119 +62,13 @@ type
|
|
|
|
|
|
procedure TestProcVars;
|
|
|
procedure TestProcVarsRecs;
|
|
|
- end;
|
|
|
|
|
|
-{$ifndef fpc}
|
|
|
- TValueHelper = record helper for TValue
|
|
|
- function AsUnicodeString: UnicodeString;
|
|
|
- function AsAnsiString: AnsiString;
|
|
|
+ procedure TestProc;
|
|
|
+ procedure TestProcRecs;
|
|
|
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;
|
|
|
- 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
|
|
@@ -634,6 +525,102 @@ begin
|
|
|
DoStaticInvokeTestClassCompare('TTestClass Pascal', @TestTTestClassPascal, ccPascal, values, TypeInfo(TTestClass), rescls);
|
|
|
end;
|
|
|
|
|
|
+const
|
|
|
+ SingleArg1: Single = 1.23;
|
|
|
+ SingleArg2In: Single = 3.21;
|
|
|
+ SingleArg2Out: Single = 2.34;
|
|
|
+ SingleArg3Out: Single = 9.87;
|
|
|
+ SingleArg4: Single = 7.89;
|
|
|
+ SingleRes: Single = 4.32;
|
|
|
+ SingleAddArg1 = Single(1.23);
|
|
|
+ SingleAddArg2 = Single(2.34);
|
|
|
+ SingleAddArg3 = Single(3.45);
|
|
|
+ SingleAddArg4 = Single(4.56);
|
|
|
+ SingleAddArg5 = Single(5.67);
|
|
|
+ SingleAddArg6 = Single(9.87);
|
|
|
+ SingleAddArg7 = Single(8.76);
|
|
|
+ SingleAddArg8 = Single(7.65);
|
|
|
+ SingleAddArg9 = Single(6.54);
|
|
|
+ SingleAddArg10 = Single(5.43);
|
|
|
+ SingleAddRes = SingleAddArg1 + SingleAddArg2 + SingleAddArg3 + SingleAddArg4 + SingleAddArg5 +
|
|
|
+ SingleAddArg6 + SingleAddArg7 + SingleAddArg8 + SingleAddArg9 + SingleAddArg10;
|
|
|
+
|
|
|
+ DoubleArg1: Double = 1.23;
|
|
|
+ DoubleArg2In: Double = 3.21;
|
|
|
+ DoubleArg2Out: Double = 2.34;
|
|
|
+ DoubleArg3Out: Double = 9.87;
|
|
|
+ DoubleArg4: Double = 7.89;
|
|
|
+ DoubleRes: Double = 4.32;
|
|
|
+ DoubleAddArg1 = Double(1.23);
|
|
|
+ DoubleAddArg2 = Double(2.34);
|
|
|
+ DoubleAddArg3 = Double(3.45);
|
|
|
+ DoubleAddArg4 = Double(4.56);
|
|
|
+ DoubleAddArg5 = Double(5.67);
|
|
|
+ DoubleAddArg6 = Double(9.87);
|
|
|
+ DoubleAddArg7 = Double(8.76);
|
|
|
+ DoubleAddArg8 = Double(7.65);
|
|
|
+ DoubleAddArg9 = Double(6.54);
|
|
|
+ DoubleAddArg10 = Double(5.43);
|
|
|
+ DoubleAddRes = DoubleAddArg1 + DoubleAddArg2 + DoubleAddArg3 + DoubleAddArg4 + DoubleAddArg5 +
|
|
|
+ DoubleAddArg6 + DoubleAddArg7 + DoubleAddArg8 + DoubleAddArg9 + DoubleAddArg10;
|
|
|
+
|
|
|
+ ExtendedArg1: Extended = 1.23;
|
|
|
+ ExtendedArg2In: Extended = 3.21;
|
|
|
+ ExtendedArg2Out: Extended = 2.34;
|
|
|
+ ExtendedArg3Out: Extended = 9.87;
|
|
|
+ ExtendedArg4: Extended = 7.89;
|
|
|
+ ExtendedRes: Extended = 4.32;
|
|
|
+ ExtendedAddArg1 = Extended(1.23);
|
|
|
+ ExtendedAddArg2 = Extended(2.34);
|
|
|
+ ExtendedAddArg3 = Extended(3.45);
|
|
|
+ ExtendedAddArg4 = Extended(4.56);
|
|
|
+ ExtendedAddArg5 = Extended(5.67);
|
|
|
+ ExtendedAddArg6 = Extended(9.87);
|
|
|
+ ExtendedAddArg7 = Extended(8.76);
|
|
|
+ ExtendedAddArg8 = Extended(7.65);
|
|
|
+ ExtendedAddArg9 = Extended(6.54);
|
|
|
+ ExtendedAddArg10 = Extended(5.43);
|
|
|
+ ExtendedAddRes = ExtendedAddArg1 + ExtendedAddArg2 + ExtendedAddArg3 + ExtendedAddArg4 + ExtendedAddArg5 +
|
|
|
+ ExtendedAddArg6 + ExtendedAddArg7 + ExtendedAddArg8 + ExtendedAddArg9 + ExtendedAddArg10;
|
|
|
+
|
|
|
+ CurrencyArg1: Currency = 1.23;
|
|
|
+ CurrencyArg2In: Currency = 3.21;
|
|
|
+ CurrencyArg2Out: Currency = 2.34;
|
|
|
+ CurrencyArg3Out: Currency = 9.87;
|
|
|
+ CurrencyArg4: Currency = 7.89;
|
|
|
+ CurrencyRes: Currency = 4.32;
|
|
|
+ CurrencyAddArg1 = Currency(1.23);
|
|
|
+ CurrencyAddArg2 = Currency(2.34);
|
|
|
+ CurrencyAddArg3 = Currency(3.45);
|
|
|
+ CurrencyAddArg4 = Currency(4.56);
|
|
|
+ CurrencyAddArg5 = Currency(5.67);
|
|
|
+ CurrencyAddArg6 = Currency(9.87);
|
|
|
+ CurrencyAddArg7 = Currency(8.76);
|
|
|
+ CurrencyAddArg8 = Currency(7.65);
|
|
|
+ CurrencyAddArg9 = Currency(6.54);
|
|
|
+ CurrencyAddArg10 = Currency(5.43);
|
|
|
+ CurrencyAddRes = CurrencyAddArg1 + CurrencyAddArg2 + CurrencyAddArg3 + CurrencyAddArg4 + CurrencyAddArg5 +
|
|
|
+ CurrencyAddArg6 + CurrencyAddArg7 + CurrencyAddArg8 + CurrencyAddArg9 + CurrencyAddArg10;
|
|
|
+
|
|
|
+ CompArg1: Comp = 123;
|
|
|
+ CompArg2In: Comp = 321;
|
|
|
+ CompArg2Out: Comp = 234;
|
|
|
+ CompArg3Out: Comp = 987;
|
|
|
+ CompArg4: Comp = 789;
|
|
|
+ CompRes: Comp = 432;
|
|
|
+ CompAddArg1 = Comp(123);
|
|
|
+ CompAddArg2 = Comp(234);
|
|
|
+ CompAddArg3 = Comp(345);
|
|
|
+ CompAddArg4 = Comp(456);
|
|
|
+ CompAddArg5 = Comp(567);
|
|
|
+ CompAddArg6 = Comp(987);
|
|
|
+ CompAddArg7 = Comp(876);
|
|
|
+ CompAddArg8 = Comp(765);
|
|
|
+ CompAddArg9 = Comp(654);
|
|
|
+ CompAddArg10 = Comp(543);
|
|
|
+ CompAddRes = CompAddArg1 + CompAddArg2 + CompAddArg3 + CompAddArg4 + CompAddArg5 +
|
|
|
+ CompAddArg6 + CompAddArg7 + CompAddArg8 + CompAddArg9 + CompAddArg10;
|
|
|
+
|
|
|
type
|
|
|
TTestRecord1 = packed record
|
|
|
b: array[0..0] of Byte;
|
|
@@ -689,6 +676,16 @@ type
|
|
|
procedure Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
|
|
|
procedure Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
|
|
|
procedure Test12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
|
|
|
+ function Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
|
|
|
+ function Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
|
|
|
+ function Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
|
|
|
+ function Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
|
|
|
+ function Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
|
|
|
+ function Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
|
|
|
+ function Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
|
|
|
+ function Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
|
|
|
+ function Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
|
|
|
+ function Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
|
|
|
|
|
|
function TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
|
|
|
function TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
|
|
@@ -717,6 +714,16 @@ type
|
|
|
procedure Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
|
|
|
procedure Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
|
|
|
procedure Test12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
|
|
|
+ function Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
|
|
|
+ function Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
|
|
|
+ function Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
|
|
|
+ function Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
|
|
|
+ function Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
|
|
|
+ function Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
|
|
|
+ function Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
|
|
|
+ function Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
|
|
|
+ function Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
|
|
|
+ function Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
|
|
|
|
|
|
function TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
|
|
|
function TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
|
|
@@ -754,6 +761,16 @@ type
|
|
|
TMethodTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString) of object;
|
|
|
TMethodTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString) of object;
|
|
|
TMethodTest12 = procedure(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt) of object;
|
|
|
+ TMethodTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single of object;
|
|
|
+ TMethodTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double of object;
|
|
|
+ TMethodTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended of object;
|
|
|
+ TMethodTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp of object;
|
|
|
+ TMethodTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency of object;
|
|
|
+ TMethodTest18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single of object;
|
|
|
+ TMethodTest19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double of object;
|
|
|
+ TMethodTest20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object;
|
|
|
+ TMethodTest21 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object;
|
|
|
+ TMethodTest22 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object;
|
|
|
|
|
|
TMethodTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1 of object;
|
|
|
TMethodTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2 of object;
|
|
@@ -778,6 +795,16 @@ type
|
|
|
TProcVarTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
|
|
|
TProcVarTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
|
|
|
TProcVarTest12 = procedure(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
|
|
|
+ TProcVarTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
|
|
|
+ TProcVarTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
|
|
|
+ TProcVarTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
|
|
|
+ TProcVarTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
|
|
|
+ TProcVarTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
|
|
|
+ TProcVarTest18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
|
|
|
+ TProcVarTest19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
|
|
|
+ TProcVarTest20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
|
|
|
+ TProcVarTest21 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
|
|
|
+ TProcVarTest22 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
|
|
|
|
|
|
TProcVarTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1;
|
|
|
TProcVarTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2;
|
|
@@ -961,6 +988,206 @@ begin
|
|
|
{$endif}
|
|
|
end;
|
|
|
|
|
|
+function TTestInterfaceClass.Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 4);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ aArg2 := SingleArg2Out;
|
|
|
+ aArg3 := SingleArg3Out;
|
|
|
+ SetLength(OutputArgs, 2);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
|
|
|
+ SetLength(InOutMapping, 2);
|
|
|
+ InOutMapping[0] := 1;
|
|
|
+ InOutMapping[1] := 2;
|
|
|
+ Result := SingleRes;
|
|
|
+ TValue.Make(@Result, TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 13;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 4);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ aArg2 := DoubleArg2Out;
|
|
|
+ aArg3 := DoubleArg3Out;
|
|
|
+ SetLength(OutputArgs, 2);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
|
|
|
+ SetLength(InOutMapping, 2);
|
|
|
+ InOutMapping[0] := 1;
|
|
|
+ InOutMapping[1] := 2;
|
|
|
+ Result := DoubleRes;
|
|
|
+ TValue.Make(@Result, TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 14;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 4);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ aArg2 := ExtendedArg2Out;
|
|
|
+ aArg3 := ExtendedArg3Out;
|
|
|
+ SetLength(OutputArgs, 2);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
|
|
|
+ SetLength(InOutMapping, 2);
|
|
|
+ InOutMapping[0] := 1;
|
|
|
+ InOutMapping[1] := 2;
|
|
|
+ Result := ExtendedRes;
|
|
|
+ TValue.Make(@Result, TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 15;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 4);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ aArg2 := CompArg2Out;
|
|
|
+ aArg3 := CompArg3Out;
|
|
|
+ SetLength(OutputArgs, 2);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
|
|
|
+ SetLength(InOutMapping, 2);
|
|
|
+ InOutMapping[0] := 1;
|
|
|
+ InOutMapping[1] := 2;
|
|
|
+ Result := CompRes;
|
|
|
+ TValue.Make(@Result, TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 16;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 4);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ aArg2 := CurrencyArg2Out;
|
|
|
+ aArg3 := CurrencyArg3Out;
|
|
|
+ SetLength(OutputArgs, 2);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
|
|
|
+ SetLength(InOutMapping, 2);
|
|
|
+ InOutMapping[0] := 1;
|
|
|
+ InOutMapping[1] := 2;
|
|
|
+ Result := CurrencyRes;
|
|
|
+ TValue.Make(@Result, TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 17;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 10);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
|
|
|
+ TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
|
|
|
+ TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
|
|
|
+ TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
|
|
|
+ TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
|
|
|
+ TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
|
|
|
+ SetLength(OutputArgs, 0);
|
|
|
+ SetLength(InOutMapping, 0);
|
|
|
+ Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
|
|
|
+ TValue.Make(@Result ,TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 18;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 10);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
|
|
|
+ TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
|
|
|
+ TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
|
|
|
+ TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
|
|
|
+ TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
|
|
|
+ TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
|
|
|
+ SetLength(OutputArgs, 0);
|
|
|
+ SetLength(InOutMapping, 0);
|
|
|
+ Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
|
|
|
+ TValue.Make(@Result ,TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 19;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 10);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
|
|
|
+ TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
|
|
|
+ TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
|
|
|
+ TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
|
|
|
+ TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
|
|
|
+ TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
|
|
|
+ SetLength(OutputArgs, 0);
|
|
|
+ SetLength(InOutMapping, 0);
|
|
|
+ Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
|
|
|
+ TValue.Make(@Result ,TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 20;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 10);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
|
|
|
+ TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
|
|
|
+ TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
|
|
|
+ TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
|
|
|
+ TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
|
|
|
+ TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
|
|
|
+ SetLength(OutputArgs, 0);
|
|
|
+ SetLength(InOutMapping, 0);
|
|
|
+ Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
|
|
|
+ TValue.Make(@Result ,TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 21;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestInterfaceClass.Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
|
|
|
+begin
|
|
|
+ SetLength(InputArgs, 10);
|
|
|
+ TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
|
|
|
+ TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
|
|
|
+ TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
|
|
|
+ TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
|
|
|
+ TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
|
|
|
+ TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
|
|
|
+ TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
|
|
|
+ TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
|
|
|
+ TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
|
|
|
+ TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
|
|
|
+ SetLength(OutputArgs, 0);
|
|
|
+ SetLength(InOutMapping, 0);
|
|
|
+ Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
|
|
|
+ TValue.Make(@Result ,TypeInfo(Result), ResultValue);
|
|
|
+ CalledMethod := 22;
|
|
|
+end;
|
|
|
+
|
|
|
function TTestInterfaceClass.TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
|
|
|
var
|
|
|
i: LongInt;
|
|
@@ -1160,6 +1387,56 @@ begin
|
|
|
TTestInterfaceClass.ProcVarInst.Test12(aArg1, aArg2, aArg3, aArg4);
|
|
|
end;
|
|
|
|
|
|
+function ProcTest13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test13(aArg1, aArg2, aArg3, aArg4);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test14(aArg1, aArg2, aArg3, aArg4);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test15(aArg1, aArg2, aArg3, aArg4);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test16(aArg1, aArg2, aArg3, aArg4);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test17(aArg1, aArg2, aArg3, aArg4);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
|
|
|
+end;
|
|
|
+
|
|
|
+function ProcTest22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
|
|
|
+begin
|
|
|
+ Result := TTestInterfaceClass.ProcVarInst.Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
|
|
|
+end;
|
|
|
+
|
|
|
function ProcTestRecSize1(aArg1: TTestRecord1): TTestRecord1;
|
|
|
begin
|
|
|
Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize1(aArg1);
|
|
@@ -1210,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
|
|
@@ -1396,6 +1655,69 @@ begin
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
+procedure TTestInvoke.DoProcInvoke(aInst: TObject; aProc: CodePointer;
|
|
|
+ aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray;
|
|
|
+ aResult: TValue);
|
|
|
+var
|
|
|
+ cls: TTestInterfaceClass;
|
|
|
+ name: String;
|
|
|
+ context: TRttiContext;
|
|
|
+ t: TRttiType;
|
|
|
+ callable, res: TValue;
|
|
|
+ proc: TRttiProcedureType;
|
|
|
+ i: SizeInt;
|
|
|
+ input: array of TValue;
|
|
|
+ restype: PTypeInfo;
|
|
|
+begin
|
|
|
+ cls := aInst as TTestInterfaceClass;
|
|
|
+ cls.Reset;
|
|
|
+
|
|
|
+ if aIndex and TTestInterfaceClass.RecSizeMarker <> 0 then begin
|
|
|
+ name := 'TestRecSize' + IntToStr(aIndex and not TTestInterfaceClass.RecSizeMarker);
|
|
|
+ TTestInterfaceClass.ProcVarRecInst := cls;
|
|
|
+ end else begin
|
|
|
+ name := 'Test' + IntToStr(aIndex);
|
|
|
+ TTestInterfaceClass.ProcVarInst := cls;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TValue.Make(@aProc, aTypeInfo, callable);
|
|
|
+
|
|
|
+ context := TRttiContext.Create;
|
|
|
+ try
|
|
|
+ t := context.GetType(aTypeInfo);
|
|
|
+ Check(t is TRttiProcedureType, 'Not a procedure variable: ' + aTypeInfo^.Name);
|
|
|
+ proc := t as TRttiProcedureType;
|
|
|
+
|
|
|
+ { arguments might be modified by Invoke (Note: Copy() does not uniquify the
|
|
|
+ IValueData of managed types) }
|
|
|
+ SetLength(input, Length(aInputArgs));
|
|
|
+ for i := 0 to High(input) do
|
|
|
+ input[i] := CopyValue(aInputArgs[i]);
|
|
|
+
|
|
|
+ if Assigned(proc.ReturnType) then
|
|
|
+ restype := PTypeInfo(proc.ReturnType.Handle)
|
|
|
+ else
|
|
|
+ restype := Nil;
|
|
|
+
|
|
|
+ res := Rtti.Invoke(aProc, aInputArgs, proc.CallingConvention, restype, True, False);
|
|
|
+ CheckEquals(aIndex, cls.CalledMethod, 'Wrong method called for ' + name);
|
|
|
+ Check(EqualValues(cls.ResultValue, res), 'Reported result value differs from returned for ' + name);
|
|
|
+ Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
|
|
|
+ CheckEquals(Length(aInputArgs), Length(cls.InputArgs), 'Count of input args differs for ' + name);
|
|
|
+ CheckEquals(Length(cls.OutputArgs), Length(cls.InOutMapping), 'Count of output args and in-out-mapping differs for ' + name);
|
|
|
+ CheckEquals(Length(aOutputArgs), Length(cls.OutputArgs), 'Count of output args differs for ' + name);
|
|
|
+ for i := 0 to High(aInputArgs) do begin
|
|
|
+ Check(EqualValues(input[i], cls.InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
|
|
|
+ end;
|
|
|
+ for i := 0 to High(aOutputArgs) do begin
|
|
|
+ Check(EqualValues(aOutputArgs[i], cls.OutputArgs[i]), Format('Output argument %d differs for %s', [i + 1, name]));
|
|
|
+ Check(EqualValues(aOutputArgs[i], aInputArgs[cls.InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ context.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
{$ifndef InLazIDE}
|
|
|
{$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
begin
|
|
@@ -1407,6 +1729,11 @@ begin
|
|
|
DoProcVarInvoke(aInst, CodePointer(aProc), TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aResult);
|
|
|
end;
|
|
|
|
|
|
+{$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoProcInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
|
|
|
+begin
|
|
|
+ DoProcInvoke(aInst, CodePointer(aProc), TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aResult);
|
|
|
+end;
|
|
|
+
|
|
|
{$ifdef fpc}generic{$endif} function TTestInvoke.GetRecValue<T>(aReverse: Boolean): TValue;
|
|
|
var
|
|
|
i: LongInt;
|
|
@@ -1425,28 +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;
|
|
|
-
|
|
|
-{$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);
|
|
@@ -1493,6 +1798,61 @@ begin
|
|
|
GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
|
|
|
], TValue.Empty);
|
|
|
{$endif}
|
|
|
+
|
|
|
+ DoIntfInvoke(13, [
|
|
|
+ GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
|
|
|
+ ], [
|
|
|
+ GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
|
|
|
+ ], GetSingleValue(SingleRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(14, [
|
|
|
+ GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
|
|
|
+ ], [
|
|
|
+ GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
|
|
|
+ ], GetDoubleValue(DoubleRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(15, [
|
|
|
+ GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
|
|
|
+ ], [
|
|
|
+ GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
|
|
|
+ ], GetExtendedValue(ExtendedRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(16, [
|
|
|
+ GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
|
|
|
+ ], [
|
|
|
+ GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
|
|
|
+ ], GetCompValue(CompRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(17, [
|
|
|
+ GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
|
|
|
+ ], [
|
|
|
+ GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
|
|
|
+ ], GetCurrencyValue(CurrencyRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(18, [
|
|
|
+ GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
|
|
|
+ GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
|
|
|
+ ], [], GetSingleValue(SingleAddRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(19, [
|
|
|
+ GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
|
|
|
+ GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
|
|
|
+ ], [], GetDoubleValue(DoubleAddRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(20, [
|
|
|
+ GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
|
|
|
+ GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
|
|
|
+ ], [], GetExtendedValue(ExtendedAddRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(21, [
|
|
|
+ GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
|
|
|
+ GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
|
|
|
+ ], [], GetCompValue(CompAddRes));
|
|
|
+
|
|
|
+ DoIntfInvoke(22, [
|
|
|
+ GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
|
|
|
+ GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
|
|
|
+ ], [], GetCurrencyValue(CurrencyAddRes));
|
|
|
end;
|
|
|
|
|
|
procedure TTestInvoke.TestIntfMethodsRecs;
|
|
@@ -1588,6 +1948,61 @@ begin
|
|
|
GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
|
|
|
], TValue.Empty);
|
|
|
{$endif}
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest13>(cls, {$ifdef fpc}@{$endif}cls.Test13, 13, [
|
|
|
+ GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
|
|
|
+ ], [
|
|
|
+ GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
|
|
|
+ ], GetSingleValue(SingleRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest14>(cls, {$ifdef fpc}@{$endif}cls.Test14, 14, [
|
|
|
+ GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
|
|
|
+ ], [
|
|
|
+ GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
|
|
|
+ ], GetDoubleValue(DoubleRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest15>(cls, {$ifdef fpc}@{$endif}cls.Test15, 15, [
|
|
|
+ GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
|
|
|
+ ], [
|
|
|
+ GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
|
|
|
+ ], GetExtendedValue(ExtendedRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest16>(cls, {$ifdef fpc}@{$endif}cls.Test16, 16, [
|
|
|
+ GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
|
|
|
+ ], [
|
|
|
+ GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
|
|
|
+ ], GetCompValue(CompRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest17>(cls, {$ifdef fpc}@{$endif}cls.Test17, 17, [
|
|
|
+ GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
|
|
|
+ ], [
|
|
|
+ GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
|
|
|
+ ], GetCurrencyValue(CurrencyRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest18>(cls, {$ifdef fpc}@{$endif}cls.Test18, 18, [
|
|
|
+ GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
|
|
|
+ GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
|
|
|
+ ], [], GetSingleValue(SingleAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest19>(cls, {$ifdef fpc}@{$endif}cls.Test19, 19, [
|
|
|
+ GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
|
|
|
+ GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
|
|
|
+ ], [], GetDoubleValue(DoubleAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest20>(cls, {$ifdef fpc}@{$endif}cls.Test20, 20, [
|
|
|
+ GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
|
|
|
+ GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
|
|
|
+ ], [], GetExtendedValue(ExtendedAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest21>(cls, {$ifdef fpc}@{$endif}cls.Test21, 21, [
|
|
|
+ GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
|
|
|
+ GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
|
|
|
+ ], [], GetCompValue(CompAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest22>(cls, {$ifdef fpc}@{$endif}cls.Test22, 22, [
|
|
|
+ GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
|
|
|
+ GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
|
|
|
+ ], [], GetCurrencyValue(CurrencyAddRes));
|
|
|
finally
|
|
|
cls.Free;
|
|
|
end;
|
|
@@ -1693,6 +2108,61 @@ begin
|
|
|
GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
|
|
|
], TValue.Empty);
|
|
|
{$endif}
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest13>(cls, {$ifdef fpc}@{$endif}ProcTest13, 13, [
|
|
|
+ GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
|
|
|
+ ], [
|
|
|
+ GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
|
|
|
+ ], GetSingleValue(SingleRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest14>(cls, {$ifdef fpc}@{$endif}ProcTest14, 14, [
|
|
|
+ GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
|
|
|
+ ], [
|
|
|
+ GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
|
|
|
+ ], GetDoubleValue(DoubleRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest15>(cls, {$ifdef fpc}@{$endif}ProcTest15, 15, [
|
|
|
+ GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
|
|
|
+ ], [
|
|
|
+ GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
|
|
|
+ ], GetExtendedValue(ExtendedRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest16>(cls, {$ifdef fpc}@{$endif}ProcTest16, 16, [
|
|
|
+ GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
|
|
|
+ ], [
|
|
|
+ GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
|
|
|
+ ], GetCompValue(CompRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest17>(cls, {$ifdef fpc}@{$endif}ProcTest17, 17, [
|
|
|
+ GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
|
|
|
+ ], [
|
|
|
+ GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
|
|
|
+ ], GetCurrencyValue(CurrencyRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest18>(cls, {$ifdef fpc}@{$endif}ProcTest18, 18, [
|
|
|
+ GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
|
|
|
+ GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
|
|
|
+ ], [], GetSingleValue(SingleAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest19>(cls, {$ifdef fpc}@{$endif}ProcTest19, 19, [
|
|
|
+ GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
|
|
|
+ GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
|
|
|
+ ], [], GetDoubleValue(DoubleAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest20>(cls, {$ifdef fpc}@{$endif}ProcTest20, 20, [
|
|
|
+ GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
|
|
|
+ GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
|
|
|
+ ], [], GetExtendedValue(ExtendedAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest21>(cls, {$ifdef fpc}@{$endif}ProcTest21, 21, [
|
|
|
+ GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
|
|
|
+ GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
|
|
|
+ ], [], GetCompValue(CompAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest22>(cls, {$ifdef fpc}@{$endif}ProcTest22, 22, [
|
|
|
+ GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
|
|
|
+ GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
|
|
|
+ ], [], GetCurrencyValue(CurrencyAddRes));
|
|
|
finally
|
|
|
cls.Free;
|
|
|
end;
|
|
@@ -1748,6 +2218,168 @@ begin
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
+procedure TTestInvoke.TestProc;
|
|
|
+var
|
|
|
+ cls: TTestInterfaceClass;
|
|
|
+begin
|
|
|
+ cls := TTestInterfaceClass.Create;
|
|
|
+ try
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest1>(cls, {$ifdef fpc}@{$endif}ProcTest1, 1, [], [], TValue.Empty);
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest2>(cls, {$ifdef fpc}@{$endif}ProcTest2, 2, [], [], TValue.{$ifdef fpc}{$ifdef fpc}specialize{$endif}{$endif}From<SizeInt>(42));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest3>(cls, {$ifdef fpc}@{$endif}ProcTest3, 3, [
|
|
|
+ GetIntValue(7), GetIntValue(2), GetIntValue(5), GetIntValue(1), GetIntValue(10), GetIntValue(8), GetIntValue(6), GetIntValue(3), GetIntValue(9), GetIntValue(3)
|
|
|
+ ], [], GetIntValue(42));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest4>(cls, {$ifdef fpc}@{$endif}ProcTest4, 4, [
|
|
|
+ TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Alpha'),
|
|
|
+ TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Beta'),
|
|
|
+ TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Gamma'),
|
|
|
+ TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Delta')
|
|
|
+ ], [], TValue.Empty);
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest5>(cls, {$ifdef fpc}@{$endif}ProcTest5, 5, [], [], TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Hello World'));
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest6>(cls, {$ifdef fpc}@{$endif}ProcTest6, 6, [], [], TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Hello World'));
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest7>(cls, {$ifdef fpc}@{$endif}ProcTest7, 7, [], [], TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Hello World'));
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest8>(cls, {$ifdef fpc}@{$endif}ProcTest8, 8, [], [], TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Hello World'));
|
|
|
+
|
|
|
+{$ifdef NEEDS_POINTER_HELPER}
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest9>(cls, {$ifdef fpc}@{$endif}ProcTest9, 9, [
|
|
|
+ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
|
|
|
+ ], [
|
|
|
+ GetIntValue($1234), GetIntValue($5678)
|
|
|
+ ], TValue.Empty);
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest10>(cls, {$ifdef fpc}@{$endif}ProcTest10, 10, [
|
|
|
+ GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
|
|
|
+ ], [
|
|
|
+ GetAnsiString('Foo'), GetAnsiString('Bar')
|
|
|
+ ], TValue.Empty);
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest11>(cls, {$ifdef fpc}@{$endif}ProcTest11, 11, [
|
|
|
+ GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
|
|
|
+ ], [
|
|
|
+ GetShortString('Foo'), GetShortString('Bar')
|
|
|
+ ], TValue.Empty);
|
|
|
+
|
|
|
+ {$ifdef fpc}
|
|
|
+ specialize GenDoProcInvoke<TProcVarTest12>(cls, {$ifdef fpc}@{$endif}ProcTest12, 12, [
|
|
|
+ GetArray([$1234, $2345, $3456, $4567]), GetArray([$4321, $5431, $6543, $7654]), GetArray([$5678, $6789, $7890, $8901]), GetArray([$8765, $7654, $6543, $5432])
|
|
|
+ ], [
|
|
|
+ GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
|
|
|
+ ], TValue.Empty);
|
|
|
+ {$endif}
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest13>(cls, {$ifdef fpc}@{$endif}ProcTest13, 13, [
|
|
|
+ GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
|
|
|
+ ], [
|
|
|
+ GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
|
|
|
+ ], GetSingleValue(SingleRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest14>(cls, {$ifdef fpc}@{$endif}ProcTest14, 14, [
|
|
|
+ GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
|
|
|
+ ], [
|
|
|
+ GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
|
|
|
+ ], GetDoubleValue(DoubleRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest15>(cls, {$ifdef fpc}@{$endif}ProcTest15, 15, [
|
|
|
+ GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
|
|
|
+ ], [
|
|
|
+ GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
|
|
|
+ ], GetExtendedValue(ExtendedRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest16>(cls, {$ifdef fpc}@{$endif}ProcTest16, 16, [
|
|
|
+ GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
|
|
|
+ ], [
|
|
|
+ GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
|
|
|
+ ], GetCompValue(CompRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest17>(cls, {$ifdef fpc}@{$endif}ProcTest17, 17, [
|
|
|
+ GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
|
|
|
+ ], [
|
|
|
+ GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
|
|
|
+ ], GetCurrencyValue(CurrencyRes));
|
|
|
+{$endif NEEDS_POINTER_HELPER}
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest18>(cls, {$ifdef fpc}@{$endif}ProcTest18, 18, [
|
|
|
+ GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
|
|
|
+ GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
|
|
|
+ ], [], GetSingleValue(SingleAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest19>(cls, {$ifdef fpc}@{$endif}ProcTest19, 19, [
|
|
|
+ GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
|
|
|
+ GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
|
|
|
+ ], [], GetDoubleValue(DoubleAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest20>(cls, {$ifdef fpc}@{$endif}ProcTest20, 20, [
|
|
|
+ GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
|
|
|
+ GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
|
|
|
+ ], [], GetExtendedValue(ExtendedAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest21>(cls, {$ifdef fpc}@{$endif}ProcTest21, 21, [
|
|
|
+ GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
|
|
|
+ GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
|
|
|
+ ], [], GetCompValue(CompAddRes));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTest22>(cls, {$ifdef fpc}@{$endif}ProcTest22, 22, [
|
|
|
+ GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
|
|
|
+ GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
|
|
|
+ ], [], GetCurrencyValue(CurrencyAddRes));
|
|
|
+ finally
|
|
|
+ cls.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestInvoke.TestProcRecs;
|
|
|
+var
|
|
|
+ cls: TTestInterfaceClass;
|
|
|
+begin
|
|
|
+ cls := TTestInterfaceClass.Create;
|
|
|
+ try
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize1>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize1, 1 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize2>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize2, 2 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize3>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize3, 3 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize4>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize4, 4 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize5>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize5, 5 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize6>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize6, 6 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize7>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize7, 7 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize8>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize8, 8 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize9>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize9, 9 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(True));
|
|
|
+
|
|
|
+ {$ifdef fpc}specialize{$endif} GenDoProcInvoke<TProcVarTestRecSize10>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize10, 10 or TTestInterfaceClass.RecSizeMarker,
|
|
|
+ [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(False)], [],
|
|
|
+ {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(True));
|
|
|
+ finally
|
|
|
+ cls.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
begin
|
|
|
{$ifdef fpc}
|
|
|
RegisterTest(TTestInvoke);
|