From f7817d25ff195d7ae888ae8e0e43bf7497654146 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 22 Mar 2019 22:29:20 +0000 Subject: [PATCH] * parameter type needs to be Nil for formal parameters (Delphi compatible) * adjusted test trtti15 + added test trtti19 git-svn-id: trunk@41770 - --- .gitattributes | 1 + compiler/ncgrtti.pas | 6 ++++ tests/test/trtti15.pp | 20 ++++++++--- tests/test/trtti19.pp | 77 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 100 insertions(+), 4 deletions(-) create mode 100644 tests/test/trtti19.pp diff --git a/.gitattributes b/.gitattributes index f6372a9c0f..2a56578833 100644 --- a/.gitattributes +++ b/.gitattributes @@ -13964,6 +13964,7 @@ tests/test/trtti16.pp svneol=native#text/pascal tests/test/trtti17.pp svneol=native#text/pascal tests/test/trtti18a.pp svneol=native#text/pascal tests/test/trtti18b.pp svneol=native#text/pascal +tests/test/trtti19.pp svneol=native#text/pascal tests/test/trtti2.pp svneol=native#text/plain tests/test/trtti3.pp svneol=native#text/plain tests/test/trtti4.pp svneol=native#text/plain diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index e5318a4841..bbf19fec1a 100644 --- a/compiler/ncgrtti.pas +++ b/compiler/ncgrtti.pas @@ -256,6 +256,8 @@ implementation if is_open_array(para.vardef) or is_array_of_const(para.vardef) then write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti) + else if para.vardef=cformaltype then + write_rtti_reference(tcb,nil,fullrtti) else write_rtti_reference(tcb,para.vardef,fullrtti); write_param_flag(tcb,para); @@ -1395,6 +1397,8 @@ implementation { write param type } if is_open_array(parasym.vardef) or is_array_of_const(parasym.vardef) then write_rtti_reference(tcb,tarraydef(parasym.vardef).elementdef,fullrtti) + else if parasym.vardef=cformaltype then + write_rtti_reference(tcb,nil,fullrtti) else write_rtti_reference(tcb,parasym.vardef,fullrtti); { write name of current parameter } @@ -1442,6 +1446,8 @@ implementation begin if is_open_array(tparavarsym(def.paras[i]).vardef) or is_array_of_const(tparavarsym(def.paras[i]).vardef) then write_rtti_reference(tcb,tarraydef(tparavarsym(def.paras[i]).vardef).elementdef,fullrtti) + else if tparavarsym(def.paras[i]).vardef=cformaltype then + write_rtti_reference(tcb,nil,fullrtti) else write_rtti_reference(tcb,tparavarsym(def.paras[i]).vardef,fullrtti); end; diff --git a/tests/test/trtti15.pp b/tests/test/trtti15.pp index 895224686e..8d4ce70888 100644 --- a/tests/test/trtti15.pp +++ b/tests/test/trtti15.pp @@ -24,6 +24,7 @@ type function Test7(arg1: LongInt; arg2: String): String; pascal; {$endif} function Test8(arg1: LongInt; arg2: String): String; cdecl; + procedure Test9(var arg1; out arg2; constref arg3); property T: LongInt read Test2; property T2: LongInt read Test2; end; @@ -52,10 +53,15 @@ begin ErrorHalt('Expected parameter name %s, but got %s', [aName, aParam^.Name]); if aParam^.Flags <> aFlags then ErrorHalt('Expected parameter flags %s, but got %s', [HexStr(Word(aFlags), 4), HexStr(Word(aParam^.Flags), 4)]); - if not Assigned(aParam^.ParamType) then - ErrorHalt('Expected parameter type %s, but got Nil', [aTypeInfo^.Name]); - if aParam^.ParamType^ <> aTypeInfo then - ErrorHalt('Expected parameter type %s, but got %s', [aTypeInfo^.Name, aParam^.ParamType^^.Name]); + if Assigned(aTypeInfo) then begin + if not Assigned(aParam^.ParamType) then + ErrorHalt('Expected parameter type %s, but got Nil', [aTypeInfo^.Name]); + if aParam^.ParamType^ <> aTypeInfo then + ErrorHalt('Expected parameter type %s, but got %s', [aTypeInfo^.Name, aParam^.ParamType^^.Name]); + end else begin + if Assigned(aParam^.ParamType) then + ErrorHalt('Expected Nil parameter type, but got %s', [aParam^.ParamType^^.Name]) + end; end; type @@ -221,6 +227,12 @@ begin MakeParam('$self', [pfHidden, pfSelf, pfAddress], TypeInfo(ITest)), MakeParam('arg1', [], TypeInfo(LongInt)), MakeParam('arg2', [], TypeInfo(String)) + ]), + MakeMethod('Test9', DefaultCallingConvention, mkProcedure, Nil, [ + MakeParam('$self', [pfHidden, pfSelf, pfAddress], TypeInfo(ITest)), + MakeParam('arg1', [pfVar], Nil), + MakeParam('arg2', [pfOut], Nil), + MakeParam('arg3', [pfConstRef], Nil) ]) ]); end. diff --git a/tests/test/trtti19.pp b/tests/test/trtti19.pp new file mode 100644 index 0000000000..046e900718 --- /dev/null +++ b/tests/test/trtti19.pp @@ -0,0 +1,77 @@ +program trtti19; + +{$mode objfpc} + +uses + TypInfo; + +type + TTestProc = procedure(var arg1; out arg2; constref arg3); + TTestMethod = procedure(var arg1; out arg2; constref arg3) of object; + + PParamFlags = ^TParamFlags; + PPPTypeInfo = ^PPTypeInfo; + +var + ti: PTypeInfo; + td: PTypeData; + procparam: PProcedureParam; + pb: PByte; + i: SizeInt; +begin + ti := PTypeInfo(TypeInfo(TTestProc)); + td := GetTypeData(ti); + if td^.ProcSig.ParamCount <> 3 then + Halt(1); + procparam := td^.ProcSig.GetParam(0); + if Assigned(procparam^.ParamType) then + Halt(2); + if procparam^.ParamFlags * [pfVar] <> [pfVar] then + Halt(3); + procparam := td^.ProcSig.GetParam(1); + if Assigned(procparam^.ParamType) then + Halt(4); + if procparam^.ParamFlags * [pfOut] <> [pfOut] then + Halt(5); + procparam := td^.ProcSig.GetParam(2); + if Assigned(procparam^.ParamType) then + Halt(6); + if procparam^.ParamFlags * [pfConstRef] <> [pfConstRef] then + Halt(7); + + ti := PTypeInfo(TypeInfo(TTestMethod)); + td := GetTypeData(ti); + if td^.ParamCount <> 4 then + Halt(8); + pb := @td^.ParamList[0]; + if PParamFlags(pb)^ * [pfHidden, pfSelf] <> [pfHidden, pfSelf] then + Halt(9); + pb := pb + SizeOf(TParamFlags); + pb := pb + SizeOf(Byte) + pb^; + pb := pb + SizeOf(Byte) + pb^; + if PParamFlags(pb)^ * [pfVar] <> [pfVar] then + Halt(10); + pb := pb + SizeOf(TParamFlags); + pb := pb + SizeOf(Byte) + pb^; + pb := pb + SizeOf(Byte) + pb^; + if PParamFlags(pb)^ * [pfOut] <> [pfOut] then + Halt(11); + pb := pb + SizeOf(TParamFlags); + pb := pb + SizeOf(Byte) + pb^; + pb := pb + SizeOf(Byte) + pb^; + if PParamFlags(pb)^ * [pfConstRef] <> [pfConstRef] then + Halt(12); + pb := pb + SizeOf(TParamFlags); + pb := pb + SizeOf(Byte) + pb^; + pb := pb + SizeOf(Byte) + pb^; + + pb := pb + SizeOf(TCallConv); + for i := 1 to td^.ParamCount - 1 do begin + if PPPTypeInfo(pb)[i] <> Nil then begin + Writeln(PPPTypeInfo(pb)[i]^^.Name); + Halt(12 + i); + end; + end; + + Writeln('ok'); +end.