* parameter type needs to be Nil for formal parameters (Delphi compatible)

* adjusted test trtti15
+ added test trtti19

git-svn-id: trunk@41770 -

.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

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;

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.

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.