paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 20:30:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 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... :/ )

Browse Source 
git-svn-id: trunk@42810 -
This commit is contained in:
svenbarth 2019-08-24 23:08:42 +00:00
parent 117fa8fa53
commit 63d83de063
2 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
packages/rtl-objpas/tests/tests.rtti.pas
View File

@ -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');

11
packages/rtl-objpas/tests/tests.rtti.util.pas
View File

@ -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;