paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 23:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: have unit interface symtable in stack while parsing implementation uses list (fixes issue #10477)

Browse Source 
git-svn-id: trunk@25505 -
This commit is contained in:
paul 2013-09-17 08:53:37 +00:00
parent 4d369654e0
commit 5aa919c2a8
6 changed files with 76 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -12756,6 +12756,7 @@ tests/webtbs/tw10425.pp svneol=native#text/plain
tests/webtbs/tw1044.pp svneol=native#text/plain
tests/webtbs/tw10454.pp svneol=native#text/plain
tests/webtbs/tw1046.pp svneol=native#text/plain
tests/webtbs/tw10477.pp svneol=native#text/pascal
tests/webtbs/tw10482.pp svneol=native#text/plain
tests/webtbs/tw10489.pp svneol=native#text/plain
tests/webtbs/tw10492.pp svneol=native#text/plain
@ -14299,6 +14300,7 @@ tests/webtbs/uw0701c.pp svneol=native#text/plain
tests/webtbs/uw0701d.pp svneol=native#text/plain
tests/webtbs/uw0701e.pp svneol=native#text/plain
tests/webtbs/uw0809.pp svneol=native#text/plain
tests/webtbs/uw10477.pp svneol=native#text/pascal
tests/webtbs/uw10492.pp svneol=native#text/plain
tests/webtbs/uw11182.pp svneol=native#text/plain
tests/webtbs/uw11762.pp svneol=native#text/plain

34
compiler/pmodules.pas
View File

@ -396,7 +396,7 @@ implementation
end;
procedure loadunits;
procedure loadunits(preservest:tsymtable);
var
s,sorg : ansistring;
fn : string;
@ -495,7 +495,10 @@ implementation
{ connect unitsym to the module }
pu.unitsym.module:=pu.u;
{ add to symtable stack }
symtablestack.push(pu.u.globalsymtable);
if assigned(preservest) then
symtablestack.pushafter(pu.u.globalsymtable,preservest)
else
symtablestack.push(pu.u.globalsymtable);
if (m_mac in current_settings.modeswitches) and
assigned(pu.u.globalmacrosymtable) then
macrosymtablestack.push(pu.u.globalmacrosymtable);
@ -539,16 +542,6 @@ implementation
end;
procedure parse_implementation_uses;
begin
if token=_USES then
begin
loadunits;
consume(_SEMICOLON);
end;
end;
procedure setupglobalswitches;
begin
if (cs_create_pic in current_settings.moduleswitches) then
@ -847,7 +840,7 @@ type
if not(cs_compilesystem in current_settings.moduleswitches) and
(token=_USES) then
begin
loadunits;
loadunits(nil);
{ has it been compiled at a higher level ?}
if current_module.state=ms_compiled then
exit;
@ -927,21 +920,28 @@ type
{ Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }
maybe_load_got;
symtablestack.push(current_module.globalsymtable);
if not current_module.interface_only then
begin
consume(_IMPLEMENTATION);
Message1(unit_u_loading_implementation_units,current_module.modulename^);
{ Read the implementation units }
parse_implementation_uses;
if token=_USES then
begin
loadunits(current_module.globalsymtable);
consume(_SEMICOLON);
end;
end;
if current_module.state=ms_compiled then
exit;
begin
symtablestack.pop(current_module.globalsymtable);
exit;
end;
{ All units are read, now give them a number }
current_module.updatemaps;
symtablestack.push(current_module.globalsymtable);
symtablestack.push(current_module.localsymtable);
if not current_module.interface_only then
@ -2014,7 +2014,7 @@ type
{Load the units used by the program we compile.}
if token=_USES then
begin
loadunits;
loadunits(nil);
consume_semicolon_after_uses:=true;
end
else

25
compiler/symbase.pas
View File

@ -130,7 +130,9 @@ interface
constructor create;
destructor destroy;override;
procedure clear;
function finditem(st:TSymtable):psymtablestackitem;
procedure push(st:TSymtable); virtual;
procedure pushafter(st,afterst:TSymtable); virtual;
procedure pop(st:TSymtable); virtual;
function top:TSymtable;
function getcopyuntil(finalst: TSymtable): TSymtablestack;
@ -397,6 +399,14 @@ implementation
end;
end;
function TSymtablestack.finditem(st: TSymtable): psymtablestackitem;
begin
if not assigned(stack) then
internalerror(200601233);
result:=stack;
while assigned(result)and(result^.symtable<>st) do
result:=result^.next;
end;
procedure TSymtablestack.push(st:TSymtable);
var
@ -408,6 +418,21 @@ implementation
stack:=hp;
end;
procedure TSymtablestack.pushafter(st,afterst:TSymtable);
var
hp,afteritem: psymtablestackitem;
begin
afteritem:=finditem(afterst);
if assigned(afteritem) then
begin
new(hp);
hp^.symtable:=st;
hp^.next:=afteritem^.next;
afteritem^.next:=hp;
end
else
internalerror(201309171);
end;
procedure TSymtablestack.pop(st:TSymtable);
var

10
compiler/symdef.pas
View File

@ -831,6 +831,7 @@ interface
procedure removehelpers(st: TSymtable);
public
procedure push(st: TSymtable); override;
procedure pushafter(st,afterst:TSymtable); override;
procedure pop(st: TSymtable); override;
end;
@ -1391,6 +1392,15 @@ implementation
inherited push(st);
end;
procedure tdefawaresymtablestack.pushafter(st,afterst:TSymtable);
begin
{ nested helpers will be added as well }
if (st.symtabletype in [globalsymtable,staticsymtable]) and
(sto_has_helper in st.tableoptions) then
addhelpers(st);
inherited pushafter(st,afterst);
end;
procedure tdefawaresymtablestack.pop(st: TSymtable);
begin
inherited pop(st);

7
tests/webtbs/tw10477.pp Normal file
View File

@ -0,0 +1,7 @@
program tw10477;
uses
uthlp;
begin
end.

15
tests/webtbs/uw10477.pp Normal file
View File

@ -0,0 +1,15 @@
unit uw10477;
interface
var
MyVar: longint;
implementation
{$if sizeof(MyVar)<>4}
{$Message FAIL 'Error'}
{$ifend}
end.