paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 10:49:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* duplicate procsym-unitsym fix

Browse Source
This commit is contained in:
peter 2002-12-25 01:26:56 +00:00
parent 78213ee091
commit 9147303907
3 changed files with 115 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
compiler/pdecsub.pas
View File

@ -409,6 +409,7 @@ implementation
st : tsymtable; st : tsymtable;
srsymtable : tsymtable; srsymtable : tsymtable;
storepos,procstartfilepos : tfileposinfo; storepos,procstartfilepos : tfileposinfo;
searchagain : boolean;
i: longint; i: longint;
begin begin
{ Save the position where this procedure really starts } { Save the position where this procedure really starts }
@ -521,64 +522,80 @@ implementation
(options in [potype_constructor,potype_destructor]) then (options in [potype_constructor,potype_destructor]) then
Message(parser_e_constructors_always_objects); Message(parser_e_constructors_always_objects);
akttokenpos:=procstartfilepos; repeat
aktprocsym:=tprocsym(symtablestack.search(sp)); searchagain:=false;
akttokenpos:=procstartfilepos;
aktprocsym:=tprocsym(symtablestack.search(sp));
if not(parse_only) then if not(parse_only) then
begin
{The procedure we prepare for is in the implementation
part of the unit we compile. It is also possible that we
are compiling a program, which is also some kind of
implementaion part.
We need to find out if the procedure is global. If it is
global, it is in the global symtable.}
if not assigned(aktprocsym) and
(symtablestack.symtabletype=staticsymtable) and
assigned(symtablestack.next) and
(symtablestack.next.unitid=0) then
begin
{Search the procedure in the global symtable.}
aktprocsym:=tprocsym(symtablestack.next.search(sp));
if assigned(aktprocsym) then
begin
{Check if it is a procedure.}
if aktprocsym.typ<>procsym then
DuplicateSym(aktprocsym);
{The procedure has been found. So it is
a global one. Set the flags to mark this.}
procinfo.flags:=procinfo.flags or pi_is_global;
end;
end;
end;
end;
if assigned(aktprocsym) then
begin
{ Check if overloaded is a procsym }
if aktprocsym.typ<>procsym then
begin
{ when the other symbol is a unit symbol then hide the unit
symbol. Only in tp mode because it's bad programming }
if (m_duplicate_names in aktmodeswitches) and
(aktprocsym.typ=unitsym) then
begin begin
aktprocsym.owner.rename(aktprocsym.name,'hidden'+aktprocsym.name); {The procedure we prepare for is in the implementation
end part of the unit we compile. It is also possible that we
else are compiling a program, which is also some kind of
begin implementaion part.
{ we use a different error message for tp7 so it looks more compatible }
if (m_fpc in aktmodeswitches) then We need to find out if the procedure is global. If it is
Message1(parser_e_overloaded_no_procedure,aktprocsym.realname) global, it is in the global symtable.}
else if not assigned(aktprocsym) and
DuplicateSym(aktprocsym); (symtablestack.symtabletype=staticsymtable) and
{ rename the name to an unique name to avoid an assigned(symtablestack.next) and
error when inserting the symbol in the symtable } (symtablestack.next.unitid=0) then
orgsp:=orgsp+'$'+tostr(aktfilepos.line); begin
{Search the procedure in the global symtable.}
aktprocsym:=tprocsym(symtablestack.next.search(sp));
if assigned(aktprocsym) then
begin
{Check if it is a procedure.}
if aktprocsym.typ<>procsym then
begin
{ when the other symbol is a unit symbol then hide the unit
symbol. Only in tp mode because it's bad programming }
if (m_duplicate_names in aktmodeswitches) and
(aktprocsym.typ=unitsym) then
begin
aktprocsym.owner.rename(aktprocsym.name,'hidden'+aktprocsym.name);
searchagain:=true;
end
else
DuplicateSym(aktprocsym);
end;
{The procedure has been found. So it is
a global one. Set the flags to mark this.}
procinfo.flags:=procinfo.flags or pi_is_global;
end;
end;
end; end;
{ generate a new aktprocsym }
aktprocsym:=nil; if (not searchagain) and
end; assigned(aktprocsym) then
begin
{ Check if overloaded is a procsym }
if aktprocsym.typ<>procsym then
begin
{ when the other symbol is a unit symbol then hide the unit
symbol. Only in tp mode because it's bad programming }
if (m_duplicate_names in aktmodeswitches) and
(aktprocsym.typ=unitsym) then
begin
aktprocsym.owner.rename(aktprocsym.name,'hidden'+aktprocsym.name);
searchagain:=true;
end
else
begin
{ we use a different error message for tp7 so it looks more compatible }
if (m_fpc in aktmodeswitches) then
Message1(parser_e_overloaded_no_procedure,aktprocsym.realname)
else
DuplicateSym(aktprocsym);
{ rename the name to an unique name to avoid an
error when inserting the symbol in the symtable }
orgsp:=orgsp+'$'+tostr(aktfilepos.line);
end;
{ generate a new aktprocsym }
aktprocsym:=nil;
end;
end;
until not searchagain;
end; end;
{ test again if assigned, it can be reset to recover } { test again if assigned, it can be reset to recover }
@ -2079,7 +2096,10 @@ const
end. end.
{ {
$Log$ $Log$
Revision 1.93 2002-12-24 21:21:06 peter Revision 1.94 2002-12-25 01:26:56 peter
* duplicate procsym-unitsym fix
Revision 1.93 2002/12/24 21:21:06 peter
* remove code that skipped the _ prefix for win32 imports * remove code that skipped the _ prefix for win32 imports
Revision 1.92 2002/12/23 21:24:22 peter Revision 1.92 2002/12/23 21:24:22 peter

15
compiler/psub.pas
View File

@ -657,7 +657,9 @@ implementation
begin begin
Message1(parser_p_procedure_start, Message1(parser_p_procedure_start,
aktprocdef.fullprocname); aktprocdef.fullprocname);
aktprocdef.aliasnames.insert(aktprocdef.mangledname);
if assigned(aktprocsym.owner) then
aktprocdef.aliasnames.insert(aktprocdef.mangledname);
{ set _FAIL as keyword if constructor } { set _FAIL as keyword if constructor }
if (aktprocdef.proctypeoption=potype_constructor) then if (aktprocdef.proctypeoption=potype_constructor) then
tokeninfo^[_FAIL].keyword:=m_all; tokeninfo^[_FAIL].keyword:=m_all;
@ -687,6 +689,12 @@ implementation
prevdef.nextoverloaded:=stdef; prevdef.nextoverloaded:=stdef;
end; end;
{$endif notused} {$endif notused}
{ release procsym when it was not stored in the symtable }
if not assigned(aktprocsym.owner) then
begin
aktprocsym.free;
aktprocdef.procsym:=nil;
end;
aktprocsym:=oldprocsym; aktprocsym:=oldprocsym;
aktprocdef:=oldprocdef; aktprocdef:=oldprocdef;
procinfo:=oldprocinfo; procinfo:=oldprocinfo;
@ -810,7 +818,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.81 2002-12-15 13:37:15 peter Revision 1.82 2002-12-25 01:26:56 peter
* duplicate procsym-unitsym fix
Revision 1.81 2002/12/15 13:37:15 peter
* don't include uf_init for library. The code is already called and * don't include uf_init for library. The code is already called and
does not need to be in the initfinal table does not need to be in the initfinal table

31
compiler/symtable.pas
View File

@ -1663,8 +1663,17 @@ implementation
hsym:=tsym(next.search(sym.name)); hsym:=tsym(next.search(sym.name));
if assigned(hsym) then if assigned(hsym) then
begin begin
DuplicateSym(hsym); { Delphi you can have a symbol with the same name as the
exit; unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol }
if (m_duplicate_names in aktmodeswitches) and
(hsym.typ=symconst.unitsym) then
hsym.owner.rename(hsym.name,'hidden'+hsym.name)
else
begin
DuplicateSym(hsym);
exit;
end;
end; end;
end; end;
@ -1821,8 +1830,17 @@ implementation
hsym:=tsym(next.search(sym.name)); hsym:=tsym(next.search(sym.name));
if assigned(hsym) then if assigned(hsym) then
begin begin
DuplicateSym(hsym); { Delphi you can have a symbol with the same name as the
exit; unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol }
if (m_duplicate_names in aktmodeswitches) and
(hsym.typ=symconst.unitsym) then
hsym.owner.rename(hsym.name,'hidden'+hsym.name)
else
begin
DuplicateSym(hsym);
exit;
end;
end; end;
end; end;
@ -2341,7 +2359,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.86 2002-12-21 13:07:34 peter Revision 1.87 2002-12-25 01:26:56 peter
* duplicate procsym-unitsym fix
Revision 1.86 2002/12/21 13:07:34 peter
* type redefine fix for tb0437 * type redefine fix for tb0437
Revision 1.85 2002/12/07 14:27:10 carl Revision 1.85 2002/12/07 14:27:10 carl