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

git-svn-id: trunk@25505 -

.gitattributes

@@ -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

compiler/pmodules.pas

@@ -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

compiler/symbase.pas

@@ -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

compiler/symdef.pas

@@ -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);

tests/webtbs/tw10477.pp

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

tests/webtbs/uw10477.pp

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