2
0
Эх сурвалжийг харах

* ccReg is the default calling convention on selected architectures (though I wonder why x86_64 returns ccReg as well when it does not support ccReg... :/ )

git-svn-id: trunk@42810 -
svenbarth 6 жил өмнө
parent
commit
63d83de063

+ 13 - 10
packages/rtl-objpas/tests/tests.rtti.pas

@@ -94,6 +94,9 @@ type
 
 implementation
 
+uses
+  Tests.Rtti.Util;
+
 type
 
   {$M+}
@@ -1788,7 +1791,7 @@ begin
 
     method := methods[0];
     CheckEquals(method.Name, 'Test', 'Method name of Test does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test does not match');
     Check(method.MethodKind = mkProcedure, 'Method kind of Test does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test is not Nil');
@@ -1799,7 +1802,7 @@ begin
 
     method := methods[1];
     CheckEquals(method.Name, 'Test2', 'Method name of Test2 does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test2 does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test2 does not match');
     Check(method.MethodKind = mkFunction, 'Method kind of Test2 does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test2 does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test2 is not Nil');
@@ -1811,7 +1814,7 @@ begin
 
     method := methods[2];
     CheckEquals(method.Name, 'Test3', 'Method name of Test3 does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test3 does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test3 does not match');
     Check(method.MethodKind = mkProcedure, 'Method kind of Test3 does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test3 does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test3 is not Nil');
@@ -1847,7 +1850,7 @@ begin
 
     method := methods[3];
     CheckEquals(method.Name, 'Test4', 'Method name of Test4 does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test4 does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test4 does not match');
     Check(method.MethodKind = mkFunction, 'Method kind of Test4 does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test4 does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test4 is not Nil');
@@ -1929,7 +1932,7 @@ begin
     Check(t is TRttiProcedureType, 'Rtti Type is not a procedure type');
 
     p := t as TRttiProcedureType;
-    Check(p.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(p.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(not Assigned(p.ReturnType), 'Return type is assigned');
     CheckEquals(0, Length(p.GetParameters), 'Procedure variable has parameters');
 
@@ -1939,7 +1942,7 @@ begin
     Check(t is TRttiProcedureType, 'Rtti Type is not a procedure type');
 
     p := t as TRttiProcedureType;
-    Check(p.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(p.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(p.ReturnType), 'Return type is not assigned');
     //Check(p.ReturnType is TRttiOrdinalType, 'Return type is not an ordinal type');
     CheckEquals(0, Length(p.GetParameters), 'Procedure variable has parameters');
@@ -1950,7 +1953,7 @@ begin
     Check(t is TRttiProcedureType, 'Rtti Type is not a procedure type');
 
     p := t as TRttiProcedureType;
-    Check(p.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(p.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(p.ReturnType), 'Return type is not assigned');
     Check(p.ReturnType is TRttiStringType, 'Return type is not a string type');
 
@@ -1981,7 +1984,7 @@ begin
     Check(t is TRttiMethodType, 'Rtti Type is not a method type');
 
     m := t as TRttiMethodType;
-    Check(m.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(m.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(not Assigned(m.ReturnType), 'Return type is assigned');
     CheckEquals(0, Length(m.GetParameters), 'Method variable has parameters');
 
@@ -1991,7 +1994,7 @@ begin
     Check(t is TRttiMethodType, 'Rtti Type is not a method type');
 
     m := t as TRttiMethodType;
-    Check(m.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(m.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(m.ReturnType), 'Return type is not assigned');
     //Check(p.ReturnType is TRttiOrdinalType, 'Return type is not an ordinal type');
     CheckEquals(0, Length(m.GetParameters), 'Method variable has parameters');
@@ -2002,7 +2005,7 @@ begin
     Check(t is TRttiMethodType, 'Rtti Type is not a method type');
 
     m := t as TRttiMethodType;
-    Check(m.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(m.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(m.ReturnType), 'Return type is not assigned');
     Check(m.ReturnType is TRttiStringType, 'Return type is not a string type');
 

+ 9 - 2
packages/rtl-objpas/tests/tests.rtti.util.pas

@@ -5,7 +5,7 @@ unit Tests.Rtti.Util;
 interface
 
 uses
-  Rtti;
+  TypInfo, Rtti;
 
 {$ifndef fpc}
 type
@@ -17,6 +17,13 @@ type
   end;
 {$endif}
 
+const
+{$if defined(cpui386) or defined(cpux86_64) or defined(cpum68k)}
+  DefaultCC = ccReg;
+{$else}
+  DefaultCC = ccStdCall;
+{$endif}
+
 function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
 function EqualValues({$ifdef fpc}constref{$else}const [ref]{$endif} aValue1, aValue2: TValue): Boolean;
 
@@ -37,7 +44,7 @@ function GetArray(const aArg: array of SizeInt): TValue;
 implementation
 
 uses
-  TypInfo, SysUtils, Math;
+  SysUtils, Math;
 
 {$ifndef fpc}
 function TValueHelper.AsUnicodeString: UnicodeString;