Jelajahi Sumber

Fix for Mantis #19697. For this we need to have the internal static var symbol know that it came from a static field var symbol so that we can check that for generic or not.

symsym.pas, tfieldvarsym:
  + add new field fieldvarsym which holds a reference to a tfieldvarsym if the static sym was created based on such a symbol
  + add necessary methods and code to correctly load from and store to PPU
  + add new constructor create_from_fieldvar
symcreat.pas, make_field_static: 
  * use new create_from_fieldvar constructor instead of the default one
hlcgobj.pas, finalize_static_data:
  * check whether the static var is based on a generic's class var
ppu.pas:
  * increase PPU version

+ added test

git-svn-id: trunk@27466 -
svenbarth 11 tahun lalu
induk
melakukan
5c1b8fdad9

+ 2 - 0
.gitattributes

@@ -13578,6 +13578,7 @@ tests/webtbs/tw19610.pp svneol=native#text/plain
 tests/webtbs/tw19622.pp svneol=native#text/plain
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
+tests/webtbs/tw19697.pp svneol=native#text/pascal
 tests/webtbs/tw19700.pp svneol=native#text/plain
 tests/webtbs/tw19701.pas svneol=native#text/plain
 tests/webtbs/tw19851a.pp svneol=native#text/pascal
@@ -14632,6 +14633,7 @@ tests/webtbs/uw18087b.pp svneol=native#text/pascal
 tests/webtbs/uw18909a.pp svneol=native#text/pascal
 tests/webtbs/uw18909b.pp svneol=native#text/pascal
 tests/webtbs/uw19159.pp svneol=native#text/pascal
+tests/webtbs/uw19697.pp svneol=native#text/pascal
 tests/webtbs/uw19701.pas svneol=native#text/plain
 tests/webtbs/uw19851.pp svneol=native#text/pascal
 tests/webtbs/uw2004.inc svneol=native#text/plain

+ 7 - 1
compiler/hlcgobj.pas

@@ -4480,7 +4480,13 @@ implementation
                 ) and
                not(vo_is_funcret in tstaticvarsym(p).varoptions) and
                not(vo_is_external in tstaticvarsym(p).varoptions) and
-               is_managed_type(tstaticvarsym(p).vardef) then
+               is_managed_type(tstaticvarsym(p).vardef) and
+               not (
+                   assigned(tstaticvarsym(p).fieldvarsym) and
+                   assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
+                   (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
+                 )
+               then
               finalize_sym(TAsmList(arg),tsym(p));
           end;
         procsym :

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 168;
+  CurrentPPUVersion = 169;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 1 - 1
compiler/symcreat.pas

@@ -1270,7 +1270,7 @@ implementation
       include(fieldvs.symoptions,sp_static);
       { generate the symbol which reserves the space }
       static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name;
-      hstaticvs:=cstaticvarsym.create(internal_static_field_name(static_name),vs_value,fieldvs.vardef,[]);
+      hstaticvs:=cstaticvarsym.create_from_fieldvar(static_name,fieldvs);
 {$ifdef jvm}
       { for the JVM, static field accesses are name-based and
         hence we have to keep the original name of the field.

+ 29 - 0
compiler/symsym.pas

@@ -272,14 +272,21 @@ interface
             parameters as it is done by iso pascal with the program symbols,
             isoindex contains the parameter number }
           isoindex : dword;
+          { if this static variable was created based on a class field variable then this is set
+            to the symbol of the corresponding class field }
+          fieldvarsym : tfieldvarsym;
+          fieldvarsymderef : tderef;
           constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
           constructor create_dll(const n : string;vsp:tvarspez;def:tdef);virtual;
           constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);virtual;
+          constructor create_from_fieldvar(const n:string;fieldvar:tfieldvarsym);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
+          procedure buildderef;override;
+          procedure deref;override;
           function mangledname:TSymStr;override;
           procedure set_mangledbasename(const s: TSymStr);
           function mangledbasename: TSymStr;
@@ -1813,6 +1820,13 @@ implementation
       end;
 
 
+    constructor tstaticvarsym.create_from_fieldvar(const n: string;fieldvar:tfieldvarsym);
+      begin
+        create(internal_static_field_name(n),vs_value,fieldvar.vardef,[]);
+        fieldvarsym:=fieldvar;
+      end;
+
+
     constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile);
       begin
          inherited ppuload(staticvarsym,ppufile);
@@ -1829,6 +1843,7 @@ implementation
          if vo_has_section in varoptions then
            section:=ppufile.getansistring;
 {$endif symansistr}
+         ppufile.getderef(defaultconstsymderef);
          ppuload_platform(ppufile);
       end;
 
@@ -1866,10 +1881,24 @@ implementation
 {$endif symansistr}
          if vo_has_section in varoptions then
            ppufile.putansistring(section);
+         ppufile.putderef(fieldvarsymderef);
          writeentry(ppufile,ibstaticvarsym);
       end;
 
 
+    procedure tstaticvarsym.buildderef;
+      begin
+        inherited buildderef;
+        fieldvarsymderef.build(fieldvarsym);
+      end;
+
+
+    procedure tstaticvarsym.deref;
+      begin
+        inherited deref;
+        fieldvarsym:=tfieldvarsym(fieldvarsymderef.resolve);
+      end;
+
     function tstaticvarsym.mangledname:TSymStr;
       var
         usename,

+ 16 - 0
tests/webtbs/tw19697.pp

@@ -0,0 +1,16 @@
+{ %NORUN }
+
+program tw19697;
+
+{$mode objfpc}{$H+}
+
+uses
+  uw19697;
+
+type
+  TSpecialisedClass = specialize TGenericClass<Integer>;
+
+begin
+  TSpecialisedClass.Init;
+end.
+

+ 24 - 0
tests/webtbs/uw19697.pp

@@ -0,0 +1,24 @@
+unit uw19697;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  generic TGenericClass<T> = class
+  private
+    class var
+      FItems: array of T;
+  public
+    class procedure Init;
+  end;
+
+implementation
+
+class procedure TGenericClass.Init;
+begin
+  SetLength(FItems, 1);
+end;
+
+end.
+