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 - [email protected]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
