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.
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
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
