Sfoglia il codice sorgente

* mark units as used in case only static symbols from inside object,
record or enum symtables are used (such as class helper methods)
(mantis #21808)

git-svn-id: trunk@21512 -

Jonas Maebe 13 anni fa
parent
commit
572012fad3
5 ha cambiato i file con 63 aggiunte e 3 eliminazioni
  1. 3 0
      .gitattributes
  2. 8 3
      compiler/symtable.pas
  3. 11 0
      tests/webtbs/tw21808.pp
  4. 19 0
      tests/webtbs/uw21808a.pp
  5. 22 0
      tests/webtbs/uw21808b.pp

+ 3 - 0
.gitattributes

@@ -12615,6 +12615,7 @@ tests/webtbs/tw21684.pp svneol=native#text/pascal
 tests/webtbs/tw2176.pp svneol=native#text/plain
 tests/webtbs/tw2177.pp svneol=native#text/plain
 tests/webtbs/tw2178.pp svneol=native#text/plain
+tests/webtbs/tw21808.pp svneol=native#text/plain
 tests/webtbs/tw2185.pp svneol=native#text/plain
 tests/webtbs/tw2186.pp svneol=native#text/plain
 tests/webtbs/tw2187.pp svneol=native#text/plain
@@ -13427,6 +13428,8 @@ tests/webtbs/uw2040.pp svneol=native#text/plain
 tests/webtbs/uw20909a.pas svneol=native#text/pascal
 tests/webtbs/uw20909b.pas svneol=native#text/pascal
 tests/webtbs/uw20940.pp svneol=native#text/pascal
+tests/webtbs/uw21808a.pp svneol=native#text/plain
+tests/webtbs/uw21808b.pp svneol=native#text/plain
 tests/webtbs/uw2266a.inc svneol=native#text/plain
 tests/webtbs/uw2266b.pas svneol=native#text/plain
 tests/webtbs/uw2269.inc svneol=native#text/plain

+ 8 - 3
compiler/symtable.pas

@@ -1882,16 +1882,21 @@ implementation
 *****************************************************************************}
 
      procedure addsymref(sym:tsym);
+       var
+         owner: tsymtable;
        begin
          { symbol uses count }
          sym.IncRefCount;
          { unit uses count }
+         owner:=sym.owner;
+         while owner.symtabletype in [objectsymtable,recordsymtable,enumsymtable] do
+           owner:=tdef(owner.defowner).owner;
          if assigned(current_module) and
-            (sym.owner.symtabletype=globalsymtable) then
+            (owner.symtabletype=globalsymtable) then
              begin
-               if tglobalsymtable(sym.owner).moduleid>=current_module.unitmapsize then
+               if tglobalsymtable(owner).moduleid>=current_module.unitmapsize then
                  internalerror(200501152);
-               inc(current_module.unitmap[tglobalsymtable(sym.owner).moduleid].refs);
+               inc(current_module.unitmap[tglobalsymtable(owner).moduleid].refs);
              end;
        end;
 

+ 11 - 0
tests/webtbs/tw21808.pp

@@ -0,0 +1,11 @@
+{ %opt=-vh -Seh }
+{ %norun }
+{$mode objfpc}
+uses
+  uw21808a, uw21808b;
+
+var
+  x: TC = nil;
+begin
+  x.Q; // hint should appear only when this line is commented out
+end.

+ 19 - 0
tests/webtbs/uw21808a.pp

@@ -0,0 +1,19 @@
+{$mode objfpc}
+unit uw21808a;
+
+interface
+
+type
+  TC = class
+    procedure P;
+  end;
+
+implementation
+
+procedure TC.P;
+begin
+  Writeln(1);
+end;
+
+end.
+

+ 22 - 0
tests/webtbs/uw21808b.pp

@@ -0,0 +1,22 @@
+{$mode objfpc}
+unit uw21808b;
+
+interface
+
+uses
+  uw21808a;
+
+type
+  TH = class helper for TC
+    procedure Q;
+  end;
+
+implementation
+
+procedure TH.Q;
+begin
+  Writeln(2);
+end;
+
+end.
+