Преглед изворни кода

compiler: put static variables into unit level and not into parent class/object/record (fixes bug #0018131)

git-svn-id: trunk@16494 -
paul пре 14 година
родитељ
комит
8b209be7e9
5 измењених фајлова са 55 додато и 5 уклоњено
  1. 1 0
      .gitattributes
  2. 5 4
      compiler/pdecvar.pas
  3. 1 1
      compiler/pexpr.pas
  4. 20 0
      compiler/symtable.pas
  5. 28 0
      tests/webtbs/tw18131.pp

+ 1 - 0
.gitattributes

@@ -10778,6 +10778,7 @@ tests/webtbs/tw18085.pp svneol=native#text/pascal
 tests/webtbs/tw18086.pp svneol=native#text/pascal
 tests/webtbs/tw18123.pp svneol=native#text/pascal
 tests/webtbs/tw18127.pp svneol=native#text/pascal
+tests/webtbs/tw18131.pp svneol=native#text/pascal
 tests/webtbs/tw1820.pp svneol=native#text/plain
 tests/webtbs/tw1825.pp svneol=native#text/plain
 tests/webtbs/tw1850.pp svneol=native#text/plain

+ 5 - 4
compiler/pdecvar.pas

@@ -1367,7 +1367,7 @@ implementation
       var
          sc : TFPObjectList;
          i  : longint;
-         hs,sorg : string;
+         hs,sorg,static_name : string;
          hdef,casetype : tdef;
          { maxsize contains the max. size of a variant }
          { startvarrec contains the start of the variant part of a record }
@@ -1537,14 +1537,15 @@ implementation
                        fieldvs:=tfieldvarsym(sc[i]);
                        include(fieldvs.symoptions,sp_static);
                        { generate the symbol which reserves the space }
-                       hstaticvs:=tstaticvarsym.create('$_static_'+lower(symtablestack.top.name^)+'_'+fieldvs.name,vs_value,hdef,[]);
+                       static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name;
+                       hstaticvs:=tstaticvarsym.create('$_static_'+static_name,vs_value,hdef,[]);
                        include(hstaticvs.symoptions,sp_internal);
-                       recst.defowner.owner.insert(hstaticvs);
+                       recst.get_unit_symtable.insert(hstaticvs);
                        insertbssdata(hstaticvs);
                        { generate the symbol for the access }
                        sl:=tpropaccesslist.create;
                        sl.addsym(sl_load,hstaticvs);
-                       recst.insert(tabsolutevarsym.create_ref('$'+lower(symtablestack.top.name^)+'_'+fieldvs.name,hdef,sl));
+                       recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl));
                      end;
                  end;
                end;

+ 1 - 1
compiler/pexpr.pas

@@ -1239,7 +1239,7 @@ implementation
                    begin
                       if (sp_static in sym.symoptions) then
                         begin
-                          static_name:=lower(sym.owner.name^)+'_'+sym.name;
+                          static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
                           searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable);
                           if assigned(sym) then
                             check_hints(sym,sym.symoptions,sym.deprecatedmsg);

+ 20 - 0
compiler/symtable.pas

@@ -90,6 +90,7 @@ interface
           procedure insertdef(def:TDefEntry);override;
           function is_packed: boolean;
           function has_single_field(out sym:tfieldvarsym): boolean;
+          function get_unit_symtable: tsymtable;
         protected
           _datasize       : aint;
           { size in bits of the data in case of bitpacked record. Only important during construction, }
@@ -192,6 +193,7 @@ interface
 
 {*** Misc ***}
     function  FullTypeName(def,otherdef:tdef):string;
+    function generate_nested_name(symtable:tsymtable;delimiter:string):string;
     procedure incompatibletypes(def1,def2:tdef);
     procedure hidesym(sym:TSymEntry);
     procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
@@ -1020,6 +1022,12 @@ implementation
           end;
       end;
 
+    function tabstractrecordsymtable.get_unit_symtable: tsymtable;
+      begin
+        result:=defowner.owner;
+        while assigned(result) and (result.symtabletype in [ObjectSymtable,recordsymtable]) do
+          result:=result.defowner.owner;
+      end;
 
     procedure tabstractrecordsymtable.setdatasize(val: aint);
       begin
@@ -1610,6 +1618,18 @@ implementation
         FullTypeName:=s1;
       end;
 
+    function generate_nested_name(symtable:tsymtable;delimiter:string):string;
+      begin
+        result:='';
+        while assigned(symtable) and (symtable.symtabletype=ObjectSymtable) do
+          begin
+            if (result='') then
+              result:=symtable.name^
+            else
+              result:=symtable.name^+delimiter+result;
+            symtable:=symtable.defowner.owner;
+          end;
+      end;
 
     procedure incompatibletypes(def1,def2:tdef);
       begin

+ 28 - 0
tests/webtbs/tw18131.pp

@@ -0,0 +1,28 @@
+{ %norun% }
+program tw18131;
+
+{$mode delphi}
+
+type
+  TFoo1 = class
+    type
+      TFoo2 = class
+        class var
+          x: integer;
+        constructor Create;
+      end;
+  end;
+
+constructor TFoo1.TFoo2.Create;
+begin
+  inherited;
+  inc(x);
+end;
+
+begin
+  TFoo1.TFoo2.x := 0;
+  TFoo1.TFoo2.Create.Destroy;
+  if TFoo1.TFoo2.x<>1 then
+    halt(1);
+end.
+