On 19.12.2020 16:51, Sven Barth wrote:
Considering that it's only intended for internal use, yes I'm aboard with that.
Here is the first change: http://hg.blaise.ru/public/fpc/rev/7c78bfdaed9a (attached). Strictly speaking, some local classes and interfaces can be compiled without that -- the ICE 200204175 only occurs when they have their own entities such as nested classes (not used for Closures) and non-abstract methods: -------8<------- function Foo: TClass; type Local = class type Nested = class end; procedure Method; end; procedure Local.Method; begin end; begin result := Local end; begin Foo end. -------8<------- To observe the effect, one could temporarily use the second attached patch to force FPC to compile the above test case. The following internal names are generated for it: VMT_$P$PROGRAM$_$FOO_$$_LOCAL // no change VMT_$P$PROGRAM$_$FOO_$LOCAL_$__$$_NESTED // was: ICE P$PROGRAM$_$FOO_$LOCAL_$__$$_METHOD // was: ICE Please check that such names are in line with the intended format.
I'd say in this case the bug is that the declaration of those two Cls<> types is allowed.
Looking at the excerpt from object_dec:
{ objects and class types can't be declared local } if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and not assigned(genericlist) then Message(parser_e_no_local_objects);
"assigned(genericlist)" seems intentional. Maybe, it misses a check for generic instantiation; however:
If I remember correctly *specializations* are already placed in the more nested scope if they use local types.
Judging solely by the internal names, that is not what happens.
or at least that was the plan
If you were to implement that, you would encounter the same ICE. -- βþ
# HG changeset patch # User Blaise.ru + make_mangledname: allow for local classes & interfaces diff -r 7b102c2fd615 -r 4990da1ff00c symdef.pas --- a/symdef.pas +++ b/symdef.pas @@ -1535,36 +1535,42 @@ prefix:=''; if not assigned(st) then internalerror(200204212); - { sub procedures } - while (st.symtabletype in [localsymtable,parasymtable]) do - begin - if st.defowner.typ<>procdef then - internalerror(200204173); - { Add the full mangledname of procedure to prevent - conflicts with 2 overloads having both a nested procedure - with the same name, see tb0314 (PFV) } - s:=tprocdef(st.defowner).procsym.name; - s:=s+tprocdef(st.defowner).mangledprocparanames(Length(s)); - if prefix<>'' then - prefix:=s+'_'+prefix - else - prefix:=s; - if length(prefix)>100 then - begin - crc:=0; - crc:=UpdateCrc32(crc,prefix[1],length(prefix)); - prefix:='$CRC'+hexstr(crc,8); - end; - st:=st.defowner.owner; - end; - { object/classes symtable, nested type definitions in classes require the while loop } - while st.symtabletype in [ObjectSymtable,recordsymtable] do - begin - if not (st.defowner.typ in [objectdef,recorddef]) then - internalerror(200204174); - prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix; - st:=st.defowner.owner; - end; + repeat + { sub procedures } + while (st.symtabletype in [localsymtable,parasymtable]) do + begin + if st.defowner.typ<>procdef then + internalerror(200204173); + { Add the full mangledname of the routine to prevent + conflicts with two overloads both having a local entity + -- routine (tb0314), class, interface -- with the same name } + s:=tprocdef(st.defowner).procsym.name; + s:=s+tprocdef(st.defowner).mangledprocparanames(Length(s)); + if prefix<>'' then + prefix:=s+'_'+prefix + else + prefix:=s; + if length(prefix)>100 then + begin + crc:=0; + crc:=UpdateCrc32(crc,prefix[1],length(prefix)); + prefix:='$CRC'+hexstr(crc,8); + end; + st:=st.defowner.owner; + end; + { object/classes symtable, nested type definitions in classes require the while loop } + while st.symtabletype in [ObjectSymtable,recordsymtable] do + begin + if not (st.defowner.typ in [objectdef,recorddef]) then + internalerror(200204174); + prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix; + st:=st.defowner.owner; + end; + { local classes & interfaces are possible (because of closures) } + if st.symtabletype<>localsymtable then + break; + prefix:='$'+prefix; + until false; { symtable must now be static or global } if not(st.symtabletype in [staticsymtable,globalsymtable]) then internalerror(200204175);
# HG changeset patch # User Blaise.ru TEST: allow local classes/interfaces diff -r 4990da1ff00c -r 98b295988049 pdecobj.pas --- a/pdecobj.pas +++ b/pdecobj.pas @@ -1428,9 +1428,9 @@ current_specializedef:=nil; { objects and class types can't be declared local } - if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and + {if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and not assigned(genericlist) then - Message(parser_e_no_local_objects); + Message(parser_e_no_local_objects);} { reuse forward objectdef? } if assigned(fd) then diff -r 4990da1ff00c -r 98b295988049 pdecsub.pas --- a/pdecsub.pas +++ b/pdecsub.pas @@ -934,7 +934,7 @@ { method ? } srsym:=nil; if not assigned(astruct) and - (symtablestack.top.symtablelevel=main_program_level) and + //(symtablestack.top.symtablelevel=main_program_level) and try_to_consume(_POINT) then begin repeat
_______________________________________________ fpc-devel maillist - fpc-devel@lists.freepascal.org https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel