[fpc-devel] RTTI for ProcVar types

[Steve Hildebrandt]

> Am 25.03.2013 10:01, schrieb Sven Barth:
>> Am 24.03.2013 22:49, schrieb Steve Hildebrandt:
>>> Am 24.03.2013 22:26, schrieb Sven Barth:
>>>> I don't know immediately how you can differentiate between 
>>>> anonymous types and named ones, but that would be the key difference.
>>> Since the function building the name usied to access the RTTI table 
>>> uses only the smytables to decide weather the type is annonymous or 
>>> referenced by it's name I thought that approach was ok.
>>> (symdef.pas 1434)
>>>     function Tstoreddef.rtti_mangledname(rt:trttitype):string;
>>>      ...
>>>         if assigned(typesym) and
>>>            (owner.symtabletype in [staticsymtable,globalsymtable]) then
>>>           result:=make_mangledname(prefix,owner,typesym.name)
>>>         else
>>> result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId)) 
>>>
>>>       end;
>> Somehow I have the feeling that this should be corrected... 
My knowledge of the wokings of the compiler are not detailed enought to 
judge or fix this issue.
Shall I report it on the bugtracker?
>> Or are nested types also referenced by the definition id?(I had 
>> something on my mind like Unit Type SubType with some seperators("$") 
>> in between)
> Looking at the code above you could try whether "typesym" of the 
> procvardef is assigned if it is a named one.
Checking for typesym woks fine for my test and use cases.

-------------- next part --------------
Index: compiler/ncgrtti.pas
===================================================================
--- compiler/ncgrtti.pas	(revision 24052)
+++ compiler/ncgrtti.pas	(working copy)
@@ -687,67 +687,81 @@
           methodkind : byte;
           i : integer;
         begin
+          { write method id and name }
           if po_methodpointer in def.procoptions then
+            write_header(def,tkMethod)
+          else
             begin
-               { write method id and name }
-               write_header(def,tkMethod);
-               maybe_write_align;
+              write_header(def,tkProcVar);
+              { no rtti for anonymous procdural types e.g. "foo : procedure of object;"}
+              if not assigned(def.typesym) then
+                exit;
+            end;
 
-               { write kind of method }
-               case def.proctypeoption of
-                 potype_constructor: methodkind:=mkConstructor;
-                 potype_destructor: methodkind:=mkDestructor;
-                 potype_class_constructor: methodkind:=mkClassConstructor;
-                 potype_class_destructor: methodkind:=mkClassDestructor;
-                 potype_operator: methodkind:=mkOperatorOverload;
-                 potype_procedure:
-                   if po_classmethod in def.procoptions then
-                     methodkind:=mkClassProcedure
-                   else
-                     methodkind:=mkProcedure;
-                 potype_function:
-                   if po_classmethod in def.procoptions then
-                     methodkind:=mkClassFunction
-                   else
-                     methodkind:=mkFunction;
+          maybe_write_align;
+
+          { write kind of method }
+          case def.proctypeoption of
+             potype_constructor       :
+               methodkind := mkConstructor;
+             potype_destructor        :
+               methodkind := mkDestructor;
+             potype_class_constructor :
+               methodkind := mkClassConstructor;
+             potype_class_destructor  :
+               methodkind := mkClassDestructor;
+             potype_operator          :
+               methodkind := mkOperatorOverload;
+             potype_procedure         :
+               begin
+                 if po_classmethod in def.procoptions then
+                   methodkind := mkClassProcedure
+                 else
+                   methodkind := mkProcedure;
+               end;
+             potype_function:
+               begin
+                 if po_classmethod in def.procoptions then
+                   methodkind := mkClassFunction
+                 else
+                   methodkind := mkFunction;
+               end
+           else
+             begin
+               if def.returndef = voidtype then
+                 methodkind := mkProcedure
                else
-                 begin
-                   if def.returndef = voidtype then
-                     methodkind:=mkProcedure
-                   else
-                     methodkind:=mkFunction;
-                 end;
-               end;
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
+                 methodkind := mkFunction;
+             end;
+           end;
 
-               { write parameter info. The parameters must be written in reverse order
-                 if this method uses right to left parameter pushing! }
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind));
 
-               for i:=0 to def.paras.count-1 do
-                 write_para(tparavarsym(def.paras[i]));
+           { write parameter info. The parameters must be written in reverse order
+             if this method uses right to left parameter pushing! }
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
 
-               if (methodkind=mkFunction) or (methodkind=mkClassFunction) then
-               begin
-                 { write name of result type }
-                 write_rtti_name(def.returndef);
-                 maybe_write_align;
+           for i:=0 to def.paras.count-1 do
+             write_para(tparavarsym(def.paras[i]));
 
-                 { write result typeinfo }
-                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.returndef,fullrtti)))
-               end;
+           if (methodkind=mkFunction) or (methodkind=mkClassFunction) then
+           begin
+             { write name of result type }
+             write_rtti_name(def.returndef);
+             maybe_write_align;
 
-               { write calling convention }
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
-               maybe_write_align;
+             { write result typeinfo }
+             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.returndef,fullrtti)))
+           end;
 
-               { write params typeinfo }
-               for i:=0 to def.paras.count-1 do
-                 if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then
-                   current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tparavarsym(def.paras[i]).vardef,fullrtti)));
-            end
-          else
-            write_header(def,tkProcvar);
+           { write calling convention }
+           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption]));
+           maybe_write_align;
+
+           { write params typeinfo }
+           for i:=0 to def.paras.count-1 do
+             if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tparavarsym(def.paras[i]).vardef,fullrtti)));
         end;
 
 
Index: rtl/objpas/typinfo.pp
===================================================================
--- rtl/objpas/typinfo.pp	(revision 24052)
+++ rtl/objpas/typinfo.pp	(working copy)
@@ -159,7 +159,7 @@
                HelperUnit : ShortString
                // here the properties follow as array of TPropInfo
               );
-            tkMethod:
+            tkMethod, tkProcVar:
               (MethodKind : TMethodKind;
                ParamCount : Byte;
                ParamList : array[0..1023] of Char