unit tests.rtti.invoke; {$ifdef fpc} {$mode objfpc}{$H+} {$endif} {.$define debug} interface uses {$IFDEF FPC} fpcunit,testregistry, testutils, {$ELSE FPC} TestFramework, {$ENDIF FPC} sysutils, typinfo, Rtti, Tests.Rtti.Util; type TTestInvoke = class(TTestCase) private type TInvokeFlag = ( ifStatic, ifConstructor ); TInvokeFlags = set of TInvokeFlag; private 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); procedure DoStaticInvokeTestUnicodeStringCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: UnicodeString); 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); procedure DoUntypedInvoke(aInst: TObject; aProc: CodePointer; aMethod: TMethod; aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); {$ifndef InLazIDE} {$ifdef fpc}generic{$endif} procedure GenDoMethodInvoke(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); {$ifdef fpc}generic{$endif} procedure GenDoProcvarInvoke(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); {$ifdef fpc}generic{$endif} procedure GenDoProcInvoke(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); {$ifdef fpc}generic{$endif} function GetRecValue(aReverse: Boolean): TValue; {$endif} {$ifdef fpc} procedure Status(const aMsg: String); {$endif} published procedure TestShortString; procedure TestAnsiString; procedure TestWideString; procedure TestUnicodeString; procedure TestLongInt; procedure TestInt64; procedure TestTObject; procedure TestIntfMethods; procedure TestIntfMethodsRecs; procedure TestMethodVars; procedure TestMethodVarsRecs; procedure TestProcVars; procedure TestProcVarsRecs; procedure TestProc; procedure TestProcRecs; procedure TestUntyped; end; implementation function TTestInvoke.DoInvoke(aCodeAddress: CodePointer; aArgs: TValueArray; aCallConv: TCallConv; aResultType: PTypeInfo; aFlags: TInvokeFlags; out aValid: Boolean): TValue; begin try Result := Rtti.Invoke(aCodeAddress, aArgs, aCallConv, aResultType, ifStatic in aFlags, ifConstructor in aFlags); aValid := True; except on e: ENotImplemented do begin Status('Ignoring unimplemented functionality of test'); aValid := False; end else raise; end; end; procedure TTestInvoke.DoStaticInvokeTestOrdinalCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; aResult: Int64); var resval: TValue; valid: Boolean; begin resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid); if valid and Assigned(aReturnType) and (resval.AsOrdinal <> aResult) then begin Fail('Result of test "%s" is unexpected; expected: %s, got: %s', [aTestName, IntToStr(aResult), IntToStr(resval.AsOrdinal)]); end; end; procedure TTestInvoke.DoStaticInvokeTestAnsiStringCompare( const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: AnsiString); var resval: TValue; valid: Boolean; begin resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid); if valid and Assigned(aReturnType) and (resval.AsAnsiString <> aResult) then begin Fail('Result of test "%s" is unexpected; expected: "%s", got: "%s"', [aTestName, aResult, resval.AsString]); end; end; procedure TTestInvoke.DoStaticInvokeTestUnicodeStringCompare( const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: UnicodeString ); var resval: TValue; valid: Boolean; begin resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid); if valid and Assigned(aReturnType) and (resval.AsUnicodeString <> aResult) then begin Fail('Result of test "%s" is unexpected; expected: "%s", got: "%s"', [aTestName, aResult, resval.AsString]); end; end; {$ifdef fpc} procedure TTestInvoke.Status(const aMsg: String); begin {$ifdef debug} Writeln(aMsg); {$endif} end; {$endif} function TestShortStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; register; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestShortStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; cdecl; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestShortStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; stdcall; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestShortStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; pascal; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; procedure TTestInvoke.TestShortString; const strs: array[0..5] of ShortString = ( 'This ', 'is a ', 'test ', 'of ', 'shortstring ', 'concatenation' ); var values: TValueArray; resstr: ShortString; i: LongInt; begin SetLength(values, Length(strs)); resstr := ''; for i := Low(values) to High(values) do begin TValue.Make(@strs[i], TypeInfo(ShortString), values[i]); resstr := resstr + strs[i]; end; DoStaticInvokeTestAnsiStringCompare('ShortString Register', @TestShortStringRegister, ccReg, values, TypeInfo(ShortString), resstr); DoStaticInvokeTestAnsiStringCompare('ShortString Cdecl', @TestShortStringCdecl, ccCdecl, values, TypeInfo(ShortString), resstr); DoStaticInvokeTestAnsiStringCompare('ShortString StdCall', @TestShortStringStdCall, ccStdCall, values, TypeInfo(ShortString), resstr); DoStaticInvokeTestAnsiStringCompare('ShortString Pascal', @TestShortStringPascal, ccPascal, values, TypeInfo(ShortString), resstr); end; function TestAnsiStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; register; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestAnsiStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; cdecl; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestAnsiStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; stdcall; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestAnsiStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; pascal; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; procedure TTestInvoke.TestAnsiString; const strs: array[0..5] of AnsiString = ( 'This ', 'is a ', 'test ', 'of ', 'AnsiString ', 'concatenation' ); var values: TValueArray; resstr: AnsiString; i: LongInt; begin SetLength(values, Length(strs)); resstr := ''; for i := Low(values) to High(values) do begin TValue.Make(@strs[i], TypeInfo(AnsiString), values[i]); resstr := resstr + strs[i]; end; DoStaticInvokeTestAnsiStringCompare('AnsiString Register', @TestAnsiStringRegister, ccReg, values, TypeInfo(AnsiString), resstr); DoStaticInvokeTestAnsiStringCompare('AnsiString Cdecl', @TestAnsiStringCdecl, ccCdecl, values, TypeInfo(AnsiString), resstr); DoStaticInvokeTestAnsiStringCompare('AnsiString StdCall', @TestAnsiStringStdCall, ccStdCall, values, TypeInfo(AnsiString), resstr); DoStaticInvokeTestAnsiStringCompare('AnsiString Pascal', @TestAnsiStringPascal, ccPascal, values, TypeInfo(AnsiString), resstr); end; function TestWideStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; register; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestWideStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; cdecl; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestWideStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; stdcall; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestWideStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; pascal; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; procedure TTestInvoke.TestWideString; const strs: array[0..5] of WideString = ( 'This ', 'is a ', 'test ', 'of ', 'WideString ', 'concatenation' ); var values: TValueArray; resstr: WideString; i: LongInt; begin SetLength(values, Length(strs)); resstr := ''; for i := Low(values) to High(values) do begin TValue.Make(@strs[i], TypeInfo(WideString), values[i]); resstr := resstr + strs[i]; end; DoStaticInvokeTestUnicodeStringCompare('WideString Register', @TestWideStringRegister, ccReg, values, TypeInfo(WideString), resstr); DoStaticInvokeTestUnicodeStringCompare('WideString Cdecl', @TestWideStringCdecl, ccCdecl, values, TypeInfo(WideString), resstr); DoStaticInvokeTestUnicodeStringCompare('WideString StdCall', @TestWideStringStdCall, ccStdCall, values, TypeInfo(WideString), resstr); DoStaticInvokeTestUnicodeStringCompare('WideString Pascal', @TestWideStringPascal, ccPascal, values, TypeInfo(WideString), resstr); end; function TestUnicodeStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; register; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestUnicodeStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; cdecl; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestUnicodeStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; stdcall; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; function TestUnicodeStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; pascal; begin Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6; end; procedure TTestInvoke.TestUnicodeString; const strs: array[0..5] of UnicodeString = ( 'This ', 'is a ', 'test ', 'of ', 'UnicodeString ', 'concatenation' ); var values: TValueArray; resstr: UnicodeString; i: LongInt; begin SetLength(values, Length(strs)); resstr := ''; for i := Low(values) to High(values) do begin TValue.Make(@strs[i], TypeInfo(UnicodeString), values[i]); resstr := resstr + strs[i]; end; DoStaticInvokeTestUnicodeStringCompare('UnicodeString Register', @TestUnicodeStringRegister, ccReg, values, TypeInfo(UnicodeString), resstr); DoStaticInvokeTestUnicodeStringCompare('UnicodeString Cdecl', @TestUnicodeStringCdecl, ccCdecl, values, TypeInfo(UnicodeString), resstr); DoStaticInvokeTestUnicodeStringCompare('UnicodeString StdCall', @TestUnicodeStringStdCall, ccStdCall, values, TypeInfo(UnicodeString), resstr); DoStaticInvokeTestUnicodeStringCompare('UnicodeString Pascal', @TestUnicodeStringPascal, ccPascal, values, TypeInfo(UnicodeString), resstr); end; function TestLongIntRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; register; begin Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000; end; function TestLongIntCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; cdecl; begin Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000; end; function TestLongIntStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; stdcall; begin Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000; end; function TestLongIntPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; pascal; begin Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000; end; procedure TTestInvoke.TestLongInt; const vals: array[0..5] of LongInt = ( 8, 4, 7, 3, 6, 1 ); var values: TValueArray; resval, factor: LongInt; i: LongInt; begin SetLength(values, Length(vals)); resval := 0; factor := 1; for i := Low(values) to High(values) do begin TValue.Make(@vals[i], TypeInfo(LongInt), values[i]); resval := resval + vals[i] * factor; factor := factor * 10; end; DoStaticInvokeTestOrdinalCompare('LongInt Register', @TestLongIntRegister, ccReg, values, TypeInfo(LongInt), resval); DoStaticInvokeTestOrdinalCompare('LongInt Cdecl', @TestLongIntCdecl, ccCdecl, values, TypeInfo(LongInt), resval); DoStaticInvokeTestOrdinalCompare('LongInt StdCall', @TestLongIntStdCall, ccStdCall, values, TypeInfo(LongInt), resval); DoStaticInvokeTestOrdinalCompare('LongInt Pascal', @TestLongIntPascal, ccPascal, values, TypeInfo(LongInt), resval); end; function TestInt64Register(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; register; begin Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000; end; function TestInt64Cdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; cdecl; begin Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000; end; function TestInt64StdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; stdcall; begin Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000; end; function TestInt64Pascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; pascal; begin Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000; end; procedure TTestInvoke.TestInt64; const vals: array[0..5] of Int64 = ( 8, 4, 7, 3, 6, 1 ); var values: TValueArray; resval, factor: Int64; i: LongInt; begin SetLength(values, Length(vals)); resval := 0; factor := 1; for i := Low(values) to High(values) do begin TValue.Make(@vals[i], TypeInfo(Int64), values[i]); resval := resval + vals[i] * factor; factor := factor * 100; end; DoStaticInvokeTestOrdinalCompare('Int64 Register', @TestInt64Register, ccReg, values, TypeInfo(Int64), resval); DoStaticInvokeTestOrdinalCompare('Int64 Cdecl', @TestInt64Cdecl, ccCdecl, values, TypeInfo(Int64), resval); DoStaticInvokeTestOrdinalCompare('Int64 StdCall', @TestInt64StdCall, ccStdCall, values, TypeInfo(Int64), resval); DoStaticInvokeTestOrdinalCompare('Int64 Pascal', @TestInt64Pascal, ccPascal, values, TypeInfo(Int64), resval); end; type TTestClass = class fString: String; fValue: LongInt; end; function TestTTestClassRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; register; begin Result := TTestClass.Create; Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString; Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000; end; function TestTTestClassCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; cdecl; begin Result := TTestClass.Create; Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString; Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000; end; function TestTTestClassStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; stdcall; begin Result := TTestClass.Create; Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString; Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000; end; function TestTTestClassPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; pascal; begin Result := TTestClass.Create; Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString; Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000; end; procedure TTestInvoke.TestTObject; procedure DoStaticInvokeTestClassCompare( const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; aResult: TTestClass ); var resval: TValue; rescls: TTestClass; valid: Boolean; begin resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid); if valid and Assigned(aReturnType) then begin rescls := TTestClass(PPointer(resval.GetReferenceToRawData)^); if (rescls.fString <> aResult.fString) or (rescls.fValue <> aResult.fValue) then Fail('Result of test "%s" is unexpected; expected: "%s"/%s, got: "%s"/%s', [aTestName, aResult.fString, IntToStr(aResult.fValue), rescls.fString, IntToStr(rescls.fValue)]); end; end; const strs: array[0..5] of AnsiString = ( 'This ', 'is a ', 'test ', 'of ', 'AnsiString ', 'concatenation' ); vals: array[0..5] of Int64 = ( 8, 4, 7, 3, 6, 1 ); var values: TValueArray; t, rescls: TTestClass; i, factor: LongInt; begin SetLength(values, Length(vals)); factor := 1; rescls := TTestClass.Create; for i := Low(values) to High(values) do begin t := TTestClass.Create; t.fString := strs[i]; t.fValue := vals[i]; TValue.Make(@t, TypeInfo(TTestClass), values[i]); rescls.fValue := rescls.fValue + vals[i] * factor; rescls.fString := rescls.fString + strs[i]; factor := factor * 10; end; DoStaticInvokeTestClassCompare('TTestClass Register', @TestTTestClassRegister, ccReg, values, TypeInfo(TTestClass), rescls); DoStaticInvokeTestClassCompare('TTestClass Cdecl', @TestTTestClassCdecl, ccCdecl, values, TypeInfo(TTestClass), rescls); DoStaticInvokeTestClassCompare('TTestClass StdCall', @TestTTestClassStdCall, ccStdCall, values, TypeInfo(TTestClass), rescls); 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; end; TTestRecord2 = packed record b: array[0..1] of Byte; end; TTestRecord3 = packed record b: array[0..2] of Byte; end; TTestRecord4 = packed record b: array[0..3] of Byte; end; TTestRecord5 = packed record b: array[0..4] of Byte; end; TTestRecord6 = packed record b: array[0..5] of Byte; end; TTestRecord7 = packed record b: array[0..6] of Byte; end; TTestRecord8 = packed record b: array[0..7] of Byte; end; TTestRecord9 = packed record b: array[0..8] of Byte; end; TTestRecord10 = packed record b: array[0..9] of Byte; end; {$M+} ITestInterface = interface procedure Test1; function Test2: SizeInt; function Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; procedure Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString); function Test5: AnsiString; function Test6: UnicodeString; function Test7: WideString; function Test8: ShortString; procedure Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt); 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; function TestRecSize3(aArg1: TTestRecord3): TTestRecord3; function TestRecSize4(aArg1: TTestRecord4): TTestRecord4; function TestRecSize5(aArg1: TTestRecord5): TTestRecord5; function TestRecSize6(aArg1: TTestRecord6): TTestRecord6; function TestRecSize7(aArg1: TTestRecord7): TTestRecord7; function TestRecSize8(aArg1: TTestRecord8): TTestRecord8; function TestRecSize9(aArg1: TTestRecord9): TTestRecord9; function TestRecSize10(aArg1: TTestRecord10): TTestRecord10; procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); end; {$M-} TTestInterfaceClass = class(TInterfacedObject, ITestInterface) private procedure Test1; function Test2: SizeInt; function Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; procedure Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString); function Test5: AnsiString; function Test6: UnicodeString; function Test7: WideString; function Test8: ShortString; procedure Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt); 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; function TestRecSize3(aArg1: TTestRecord3): TTestRecord3; function TestRecSize4(aArg1: TTestRecord4): TTestRecord4; function TestRecSize5(aArg1: TTestRecord5): TTestRecord5; function TestRecSize6(aArg1: TTestRecord6): TTestRecord6; function TestRecSize7(aArg1: TTestRecord7): TTestRecord7; function TestRecSize8(aArg1: TTestRecord8): TTestRecord8; function TestRecSize9(aArg1: TTestRecord9): TTestRecord9; function TestRecSize10(aArg1: TTestRecord10): TTestRecord10; procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); public InputArgs: array of TValue; OutputArgs: array of TValue; ExpectedArgs: array of TValue; OutArgs: array of TValue; ResultValue: TValue; CalledMethod: SizeInt; InOutMapping: array of SizeInt; procedure Reset; public class var ProcVarInst: TTestInterfaceClass; ProcVarRecInst: TTestInterfaceClass; public const RecSizeMarker = SizeInt($80000000); end; TMethodTest1 = procedure of object; TMethodTest2 = function: SizeInt of object; TMethodTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt of object; TMethodTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString) of object; TMethodTest5 = function: AnsiString of object; TMethodTest6 = function: UnicodeString of object; TMethodTest7 = function: WideString of object; TMethodTest8 = function: ShortString of object; TMethodTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt) of object; 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; TMethodTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3 of object; TMethodTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4 of object; TMethodTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5 of object; TMethodTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6 of object; TMethodTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7 of object; TMethodTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8 of object; TMethodTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9 of object; TMethodTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10 of object; TMethodTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object; TProcVarTest1 = procedure; TProcVarTest2 = function: SizeInt; TProcVarTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; TProcVarTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString); TProcVarTest5 = function: AnsiString; TProcVarTest6 = function: UnicodeString; TProcVarTest7 = function: WideString; TProcVarTest8 = function: ShortString; TProcVarTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt); 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; TProcVarTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3; TProcVarTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4; TProcVarTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5; TProcVarTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6; TProcVarTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7; TProcVarTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8; TProcVarTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9; TProcVarTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10; TProcVarTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); procedure TTestInterfaceClass.Test1; begin SetLength(InputArgs, 0); SetLength(OutputArgs, 0); ResultValue := TValue.Empty; CalledMethod := 1; end; function TTestInterfaceClass.Test2: SizeInt; begin SetLength(InputArgs, 0); SetLength(OutputArgs, 0); Result := 42; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 2; end; function TTestInterfaceClass.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; 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); Result := 42; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 3; end; procedure TTestInterfaceClass.Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString); 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]); SetLength(OutputArgs, 0); ResultValue := TValue.Empty; CalledMethod := 4; end; function TTestInterfaceClass.Test5: AnsiString; begin SetLength(InputArgs, 0); SetLength(OutputArgs, 0); Result := 'Hello World'; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 5; end; function TTestInterfaceClass.Test6: UnicodeString; begin SetLength(InputArgs, 0); SetLength(OutputArgs, 0); Result := 'Hello World'; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 6; end; function TTestInterfaceClass.Test7: WideString; begin SetLength(InputArgs, 0); SetLength(OutputArgs, 0); Result := 'Hello World'; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 7; end; function TTestInterfaceClass.Test8: ShortString; begin SetLength(InputArgs, 0); SetLength(OutputArgs, 0); Result := 'Hello World'; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 8; end; procedure TTestInterfaceClass.Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt); 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 := $1234; aArg3 := $5678; 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; ResultValue := TValue.Empty; CalledMethod := 9; end; procedure TTestInterfaceClass.Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString); 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 := 'Foo'; aArg3 := 'Bar'; 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; ResultValue := TValue.Empty; CalledMethod := 10; end; procedure TTestInterfaceClass.Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString); 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 := 'Foo'; aArg3 := 'Bar'; 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; ResultValue := TValue.Empty; CalledMethod := 11; end; procedure TTestInterfaceClass.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); {$ifdef fpc} var i: SizeInt; start: SizeInt; {$endif} begin {$ifdef fpc} SetLength(InputArgs, 4); InputArgs[0] := specialize OpenArrayToDynArrayValue(aArg1); InputArgs[1] := specialize OpenArrayToDynArrayValue(aArg2); InputArgs[2] := specialize OpenArrayToDynArrayValue(aArg3); InputArgs[3] := specialize OpenArrayToDynArrayValue(aArg4); SetLength(OutputArgs, 2); start := $4321; for i := 0 to High(aArg2) do aArg2[i] := start + i; start := $9876; for i := 0 to High(aArg3) do aArg3[i] := start + i; OutputArgs[0] := specialize OpenArrayToDynArrayValue(aArg2); OutputArgs[1] := specialize OpenArrayToDynArrayValue(aArg3); SetLength(InOutMapping, 2); InOutMapping[0] := 1; InOutMapping[1] := 2; ResultValue := TValue.Empty; CalledMethod := 12; {$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; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 1 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize2(aArg1: TTestRecord2): TTestRecord2; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 2 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize3(aArg1: TTestRecord3): TTestRecord3; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 3 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize4(aArg1: TTestRecord4): TTestRecord4; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 4 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize5(aArg1: TTestRecord5): TTestRecord5; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 5 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize6(aArg1: TTestRecord6): TTestRecord6; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 6 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize7(aArg1: TTestRecord7): TTestRecord7; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 7 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize8(aArg1: TTestRecord8): TTestRecord8; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 8 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize9(aArg1: TTestRecord9): TTestRecord9; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 9 or RecSizeMarker; end; function TTestInterfaceClass.TestRecSize10(aArg1: TTestRecord10): TTestRecord10; var i: LongInt; begin SetLength(InputArgs, 1); TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]); SetLength(OutputArgs, 0); for i := 0 to High(aArg1.b) do Result.b[High(Result.b) - i] := aArg1.b[i]; TValue.Make(@Result, TypeInfo(Result), ResultValue); CalledMethod := 10 or RecSizeMarker; end; procedure TTestInterfaceClass.TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); begin if Length(ExpectedArgs) <> 4 then Exit; if Length(OutArgs) <> 2 then Exit; SetLength(InputArgs, 4); TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, InputArgs[0]); TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, InputArgs[1]); TValue.Make(@aArg3, ExpectedArgs[2].TypeInfo, InputArgs[2]); TValue.Make(@aArg4, ExpectedArgs[3].TypeInfo, InputArgs[3]); Move(PPointer(OutArgs[0].GetReferenceToRawData)^, aArg1, OutArgs[0].DataSize); Move(PPointer(OutArgs[1].GetReferenceToRawData)^, aArg2, OutArgs[1].DataSize); SetLength(OutputArgs, 2); TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, OutputArgs[0]); TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, OutputArgs[1]); SetLength(InOutMapping, 2); InOutMapping[0] := 0; InOutMapping[1] := 1; CalledMethod := -1; end; procedure TTestInterfaceClass.Reset; begin InputArgs := Nil; OutputArgs := Nil; ExpectedArgs := Nil; OutArgs := Nil; InOutMapping := Nil; ResultValue := TValue.Empty; CalledMethod := 0; end; procedure ProcTest1; begin TTestInterfaceClass.ProcVarInst.Test1; end; function ProcTest2: SizeInt; begin Result := TTestInterfaceClass.ProcVarInst.Test2; end; function ProcTest3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; begin Result := TTestInterfaceClass.ProcVarInst.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10); end; procedure ProcTest4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString); begin TTestInterfaceClass.ProcVarInst.Test4(aArg1, aArg2, aArg3, aArg4); end; function ProcTest5: AnsiString; begin Result := TTestInterfaceClass.ProcVarInst.Test5; end; function ProcTest6: UnicodeString; begin Result := TTestInterfaceClass.ProcVarInst.Test6; end; function ProcTest7: WideString; begin Result := TTestInterfaceClass.ProcVarInst.Test7; end; function ProcTest8: ShortString; begin Result := TTestInterfaceClass.ProcVarInst.Test8; end; procedure ProcTest9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt); begin TTestInterfaceClass.ProcVarInst.Test9(aArg1, aArg2, aArg3, aArg4); end; procedure ProcTest10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString); begin TTestInterfaceClass.ProcVarInst.Test10(aArg1, aArg2, aArg3, aArg4); end; procedure ProcTest11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString); begin TTestInterfaceClass.ProcVarInst.Test11(aArg1, aArg2, aArg3, aArg4); end; procedure ProcTest12(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); 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); end; function ProcTestRecSize2(aArg1: TTestRecord2): TTestRecord2; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize2(aArg1); end; function ProcTestRecSize3(aArg1: TTestRecord3): TTestRecord3; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize3(aArg1); end; function ProcTestRecSize4(aArg1: TTestRecord4): TTestRecord4; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize4(aArg1); end; function ProcTestRecSize5(aArg1: TTestRecord5): TTestRecord5; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize5(aArg1); end; function ProcTestRecSize6(aArg1: TTestRecord6): TTestRecord6; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize6(aArg1); end; function ProcTestRecSize7(aArg1: TTestRecord7): TTestRecord7; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize7(aArg1); end; function ProcTestRecSize8(aArg1: TTestRecord8): TTestRecord8; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize8(aArg1); end; function ProcTestRecSize9(aArg1: TTestRecord9): TTestRecord9; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize9(aArg1); end; function ProcTestRecSize10(aArg1: TTestRecord10): TTestRecord10; begin Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1); end; procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); begin TTestInterfaceClass.ProcVarInst.TestUntyped(aArg1, aArg2, aArg3, aArg4); end; procedure TTestInvoke.DoIntfInvoke(aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); var cls: TTestInterfaceClass; intf: ITestInterface; name: String; context: TRttiContext; t: TRttiType; inst, res: TValue; method: TRttiMethod; i: SizeInt; input: array of TValue; begin cls := TTestInterfaceClass.Create; intf := cls; TValue.Make(@intf, TypeInfo(intf), inst); if aIndex and TTestInterfaceClass.RecSizeMarker <> 0 then name := 'TestRecSize' + IntToStr(aIndex and not TTestInterfaceClass.RecSizeMarker) else name := 'Test' + IntToStr(aIndex); context := TRttiContext.Create; try t := context.GetType(TypeInfo(ITestInterface)); method := t.GetMethod(name); Check(Assigned(method), 'Method not found: ' + name); { 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]); try res := method.Invoke(inst, aInputArgs); except DumpExceptionBacktrace(output); raise; end; 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; procedure TTestInvoke.DoMethodInvoke(aInst: TObject; aMethod: TMethod; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); var cls: TTestInterfaceClass; name: String; context: TRttiContext; t: TRttiType; callable, res: TValue; method: TRttiMethodType; i: SizeInt; input: array of TValue; begin cls := aInst as TTestInterfaceClass; cls.Reset; if aIndex and TTestInterfaceClass.RecSizeMarker <> 0 then name := 'TestRecSize' + IntToStr(aIndex and not TTestInterfaceClass.RecSizeMarker) else name := 'Test' + IntToStr(aIndex); TValue.Make(@aMethod, aTypeInfo, callable); context := TRttiContext.Create; try t := context.GetType(aTypeInfo); Check(t is TRttiMethodType, 'Not a method variable: ' + aTypeInfo^.Name); method := t as TRttiMethodType; { 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]); res := method.Invoke(callable, aInputArgs); 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; procedure TTestInvoke.DoProcVarInvoke(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; 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]); res := proc.Invoke(callable, aInputArgs); 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; 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; procedure TTestInvoke.DoUntypedInvoke(aInst: TObject; aProc: CodePointer; aMethod: TMethod; aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); var cls: TTestInterfaceClass; intf: ITestInterface; name: String; context: TRttiContext; t: TRttiType; callable, res: TValue; proc: TRttiInvokableType; method: TRttiMethod; i: SizeInt; input: array of TValue; begin cls := aInst as TTestInterfaceClass; cls.Reset; name := 'TestUntyped'; TTestInterfaceClass.ProcVarInst := cls; context := TRttiContext.Create; try method := Nil; proc := Nil; if Assigned(aProc) then begin TValue.Make(@aProc, aTypeInfo, callable); t := context.GetType(aTypeInfo); Check(t is TRttiProcedureType, 'Not a procedure variable: ' + aTypeInfo^.Name); proc := t as TRttiProcedureType; end else if Assigned(aMethod.Code) then begin TValue.Make(@aMethod, aTypeInfo, callable); t := context.GetType(aTypeInfo); Check(t is TRttiMethodType, 'Not a method variable: ' + aTypeInfo^.Name); proc := t as TRttiMethodType; end else begin intf := cls; TValue.Make(@intf, TypeInfo(intf), callable); t := context.GetType(TypeInfo(ITestInterface)); method := t.GetMethod(name); Check(Assigned(method), 'Method not found: ' + name); end; { arguments might be modified by Invoke (Note: Copy() does not uniquify the IValueData of managed types) } SetLength(input, Length(aInputArgs)); SetLength(cls.ExpectedArgs, Length(aInputArgs)); for i := 0 to High(input) do begin input[i] := CopyValue(aInputArgs[i]); cls.ExpectedArgs[i] := CopyValue(aInputArgs[i]); end; SetLength(cls.OutArgs, Length(aOutputArgs)); for i := 0 to High(cls.OutArgs) do begin cls.OutArgs[i] := CopyValue(aOutputArgs[i]); end; if Assigned(proc) then res := proc.Invoke(callable, aInputArgs) else res := method.Invoke(callable, aInputArgs); CheckEquals(-1, 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(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); begin DoMethodInvoke(aInst, TMethod(aMethod), TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aResult); end; {$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoProcVarInvoke(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue); begin DoProcVarInvoke(aInst, CodePointer(aProc), TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aResult); end; {$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoProcInvoke(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(aReverse: Boolean): TValue; var i: LongInt; arr: array of Byte; begin SetLength(arr, SizeOf(T)); RandSeed := $54827982; if not aReverse then begin for i := 0 to High(arr) do arr[i] := Random($ff); end else begin for i := High(arr) downto 0 do arr[i] := Random($ff); end; TValue.Make(@arr[0], PTypeInfo(TypeInfo(T)), Result); end; {$endif} procedure TTestInvoke.TestIntfMethods; begin DoIntfInvoke(1, [], [], TValue.Empty); DoIntfInvoke(2, [], [], TValue.{$ifdef fpc}specialize{$endif}From(42)); DoIntfInvoke(3, [ GetIntValue(7), GetIntValue(2), GetIntValue(5), GetIntValue(1), GetIntValue(10), GetIntValue(8), GetIntValue(6), GetIntValue(3), GetIntValue(9), GetIntValue(3) ], [], GetIntValue(42)); DoIntfInvoke(4, [ TValue.{$ifdef fpc}specialize{$endif}From('Alpha'), TValue.{$ifdef fpc}specialize{$endif}From('Beta'), TValue.{$ifdef fpc}specialize{$endif}From('Gamma'), TValue.{$ifdef fpc}specialize{$endif}From('Delta') ], [], TValue.Empty); DoIntfInvoke(5, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); DoIntfInvoke(6, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); DoIntfInvoke(7, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); DoIntfInvoke(8, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); DoIntfInvoke(9, [ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678) ], [ GetIntValue($1234), GetIntValue($5678) ], TValue.Empty); DoIntfInvoke(10, [ GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') ], [ GetAnsiString('Foo'), GetAnsiString('Bar') ], TValue.Empty); DoIntfInvoke(11, [ GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') ], [ GetShortString('Foo'), GetShortString('Bar') ], TValue.Empty); {$ifdef fpc} DoIntfInvoke(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} 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; begin DoIntfInvoke(1 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(2 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(3 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(4 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(5 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(6 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(7 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(8 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(9 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); DoIntfInvoke(10 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); end; procedure TTestInvoke.TestMethodVars; var cls: TTestInterfaceClass; begin cls := TTestInterfaceClass.Create; try {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test1, 1, [], [], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test2, 2, [], [], TValue.{$ifdef fpc}{$ifdef fpc}specialize{$endif}{$endif}From(42)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test3, 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} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test4, 4, [ TValue.{$ifdef fpc}specialize{$endif}From('Alpha'), TValue.{$ifdef fpc}specialize{$endif}From('Beta'), TValue.{$ifdef fpc}specialize{$endif}From('Gamma'), TValue.{$ifdef fpc}specialize{$endif}From('Delta') ], [], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test5, 5, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test6, 6, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test7, 7, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test8, 8, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test9, 9, [ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678) ], [ GetIntValue($1234), GetIntValue($5678) ], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test10, 10, [ GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') ], [ GetAnsiString('Foo'), GetAnsiString('Bar') ], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test11, 11, [ GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') ], [ GetShortString('Foo'), GetShortString('Bar') ], TValue.Empty); {$ifdef fpc} specialize GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.Test12, 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} GenDoMethodInvoke(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(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(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(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(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(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(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(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(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(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; end; procedure TTestInvoke.TestMethodVarsRecs; var cls: TTestInterfaceClass; begin cls := TTestInterfaceClass.Create; try {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize1, 1 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize2, 2 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize3, 3 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize4, 4 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize5, 5 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize6, 6 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize7, 7 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize8, 8 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize9, 9 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoMethodInvoke(cls, {$ifdef fpc}@{$endif}cls.TestRecSize10, 10 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); finally cls.Free; end; end; procedure TTestInvoke.TestProcVars; var cls: TTestInterfaceClass; begin cls := TTestInterfaceClass.Create; try {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest1, 1, [], [], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest2, 2, [], [], TValue.{$ifdef fpc}{$ifdef fpc}specialize{$endif}{$endif}From(42)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(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} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest4, 4, [ TValue.{$ifdef fpc}specialize{$endif}From('Alpha'), TValue.{$ifdef fpc}specialize{$endif}From('Beta'), TValue.{$ifdef fpc}specialize{$endif}From('Gamma'), TValue.{$ifdef fpc}specialize{$endif}From('Delta') ], [], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest5, 5, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest6, 6, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest7, 7, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest8, 8, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest9, 9, [ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678) ], [ GetIntValue($1234), GetIntValue($5678) ], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest10, 10, [ GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') ], [ GetAnsiString('Foo'), GetAnsiString('Bar') ], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTest11, 11, [ GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') ], [ GetShortString('Foo'), GetShortString('Bar') ], TValue.Empty); {$ifdef fpc} specialize GenDoProcVarInvoke(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} GenDoProcvarInvoke(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(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(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(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(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(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(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(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(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(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.TestProcVarsRecs; var cls: TTestInterfaceClass; begin cls := TTestInterfaceClass.Create; try {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize1, 1 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize2, 2 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize3, 3 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize4, 4 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize5, 5 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize6, 6 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize7, 7 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize8, 8 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize9, 9 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize10, 10 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); finally cls.Free; end; end; procedure TTestInvoke.TestProc; var cls: TTestInterfaceClass; begin cls := TTestInterfaceClass.Create; try {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest1, 1, [], [], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest2, 2, [], [], TValue.{$ifdef fpc}{$ifdef fpc}specialize{$endif}{$endif}From(42)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(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(cls, {$ifdef fpc}@{$endif}ProcTest4, 4, [ TValue.{$ifdef fpc}specialize{$endif}From('Alpha'), TValue.{$ifdef fpc}specialize{$endif}From('Beta'), TValue.{$ifdef fpc}specialize{$endif}From('Gamma'), TValue.{$ifdef fpc}specialize{$endif}From('Delta') ], [], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest5, 5, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest6, 6, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest7, 7, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest8, 8, [], [], TValue.{$ifdef fpc}specialize{$endif}From('Hello World')); {$ifdef NEEDS_POINTER_HELPER} {$ifdef fpc}specialize{$endif} GenDoProcInvoke(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(cls, {$ifdef fpc}@{$endif}ProcTest10, 10, [ GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') ], [ GetAnsiString('Foo'), GetAnsiString('Bar') ], TValue.Empty); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTest11, 11, [ GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') ], [ GetShortString('Foo'), GetShortString('Bar') ], TValue.Empty); {$ifdef fpc} specialize GenDoProcInvoke(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(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(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(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(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(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(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(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(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(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(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(cls, {$ifdef fpc}@{$endif}ProcTestRecSize1, 1 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize2, 2 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize3, 3 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize4, 4 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize5, 5 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize6, 6 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize7, 7 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize8, 8 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize9, 9 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); {$ifdef fpc}specialize{$endif} GenDoProcInvoke(cls, {$ifdef fpc}@{$endif}ProcTestRecSize10, 10 or TTestInterfaceClass.RecSizeMarker, [{$ifdef fpc}specialize{$endif} GetRecValue(False)], [], {$ifdef fpc}specialize{$endif} GetRecValue(True)); finally cls.Free; end; end; procedure TTestInvoke.TestUntyped; var cls: TTestInterfaceClass; begin cls := TTestInterfaceClass.Create; try cls._AddRef; DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678) ], [ GetIntValue($4321), GetIntValue($5678) ], TValue.Empty); DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [ TValue.{$ifdef fpc}specialize{$endif}From('Str1'), TValue.{$ifdef fpc}specialize{$endif}From('Str2'), TValue.{$ifdef fpc}specialize{$endif}From('Str3'), TValue.{$ifdef fpc}specialize{$endif}From('Str4') ], [ TValue.{$ifdef fpc}specialize{$endif}From('StrVar'), TValue.{$ifdef fpc}specialize{$endif}From('StrOut') ], TValue.Empty); DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [ TValue.{$ifdef fpc}specialize{$endif}From('Str1'), TValue.{$ifdef fpc}specialize{$endif}From('Str2'), TValue.{$ifdef fpc}specialize{$endif}From('Str3'), TValue.{$ifdef fpc}specialize{$endif}From('Str4') ], [ TValue.{$ifdef fpc}specialize{$endif}From('StrVar'), TValue.{$ifdef fpc}specialize{$endif}From('StrOut') ], TValue.Empty); DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678) ], [ GetIntValue($4321), GetIntValue($5678) ], TValue.Empty); DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [ TValue.{$ifdef fpc}specialize{$endif}From('Str1'), TValue.{$ifdef fpc}specialize{$endif}From('Str2'), TValue.{$ifdef fpc}specialize{$endif}From('Str3'), TValue.{$ifdef fpc}specialize{$endif}From('Str4') ], [ TValue.{$ifdef fpc}specialize{$endif}From('StrVar'), TValue.{$ifdef fpc}specialize{$endif}From('StrOut') ], TValue.Empty); DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [ TValue.{$ifdef fpc}specialize{$endif}From('Str1'), TValue.{$ifdef fpc}specialize{$endif}From('Str2'), TValue.{$ifdef fpc}specialize{$endif}From('Str3'), TValue.{$ifdef fpc}specialize{$endif}From('Str4') ], [ TValue.{$ifdef fpc}specialize{$endif}From('StrVar'), TValue.{$ifdef fpc}specialize{$endif}From('StrOut') ], TValue.Empty); DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [ GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678) ], [ GetIntValue($4321), GetIntValue($5678) ], TValue.Empty); DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [ TValue.{$ifdef fpc}specialize{$endif}From('Str1'), TValue.{$ifdef fpc}specialize{$endif}From('Str2'), TValue.{$ifdef fpc}specialize{$endif}From('Str3'), TValue.{$ifdef fpc}specialize{$endif}From('Str4') ], [ TValue.{$ifdef fpc}specialize{$endif}From('StrVar'), TValue.{$ifdef fpc}specialize{$endif}From('StrOut') ], TValue.Empty); DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [ TValue.{$ifdef fpc}specialize{$endif}From('Str1'), TValue.{$ifdef fpc}specialize{$endif}From('Str2'), TValue.{$ifdef fpc}specialize{$endif}From('Str3'), TValue.{$ifdef fpc}specialize{$endif}From('Str4') ], [ TValue.{$ifdef fpc}specialize{$endif}From('StrVar'), TValue.{$ifdef fpc}specialize{$endif}From('StrOut') ], TValue.Empty); finally cls._Release; end; end; begin {$ifdef fpc} RegisterTest(TTestInvoke); {$else fpc} RegisterTest(TTestInvoke.Suite); {$endif fpc} end.