Kaynağa Gözat

* pgenutil.pas, generate_specialization & psub.pas, specialize_objectdefs:
When specializing a generic the references from unitsyms to the loaded modules
needs to be reestablished, so that "unitidentifier.identifier" can be used
inside a generic without leading to an access violation.
Only global units are checked, because a generic must not use symbols from the
static symtable or from units used by the implementation section (the latter is
currently not checked)

+ added tests for the above problem for "normal" units as well as units with a namespace

git-svn-id: trunk@20245 -

svenbarth 13 yıl önce
ebeveyn
işleme
c572395f61

+ 6 - 0
.gitattributes

@@ -10347,6 +10347,8 @@ tests/test/tgeneric70.pp svneol=native#text/pascal
 tests/test/tgeneric71.pp svneol=native#text/pascal
 tests/test/tgeneric72.pp svneol=native#text/pascal
 tests/test/tgeneric73.pp svneol=native#text/pascal
+tests/test/tgeneric74.pp svneol=native#text/pascal
+tests/test/tgeneric75.pp svneol=native#text/pascal
 tests/test/tgeneric8.pp svneol=native#text/plain
 tests/test/tgeneric9.pp svneol=native#text/plain
 tests/test/tgoto.pp svneol=native#text/plain
@@ -10839,6 +10841,7 @@ tests/test/udots.prog.pp svneol=native#text/pascal
 tests/test/udots.test.pp svneol=native#text/pascal
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
+tests/test/ugeneric.test75.pp svneol=native#text/pascal
 tests/test/ugeneric10.pp svneol=native#text/plain
 tests/test/ugeneric14.pp svneol=native#text/plain
 tests/test/ugeneric3.pp svneol=native#text/plain
@@ -10846,6 +10849,9 @@ tests/test/ugeneric4.pp svneol=native#text/plain
 tests/test/ugeneric59a.pp svneol=native#text/pascal
 tests/test/ugeneric59b.pp svneol=native#text/pascal
 tests/test/ugeneric7.pp svneol=native#text/plain
+tests/test/ugeneric74a.pp svneol=native#text/pascal
+tests/test/ugeneric74b.pp svneol=native#text/pascal
+tests/test/ugeneric75.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal

+ 15 - 0
compiler/pgenutil.pas

@@ -84,6 +84,7 @@ uses
         tempst : tglobalsymtable;
         old_block_type: tblock_type;
         hashedid: thashedidstring;
+        unitsyms : tfphashobjectlist;
       begin
         { retrieve generic def that we are going to replace }
         genericdef:=tstoreddef(tt);
@@ -346,14 +347,28 @@ uses
             hmodule:=find_module_from_symtable(genericdef.owner);
             if hmodule=nil then
               internalerror(200705152);
+            { collect all unit syms in the generic's unit as we need to establish
+              their unitsym.module link again so that unit identifiers can be used }
+            unitsyms:=tfphashobjectlist.create(false);
+            if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
+              for i:=0 to hmodule.globalsymtable.symlist.count-1 do
+                begin
+                  srsym:=tsym(hmodule.globalsymtable.symlist[i]);
+                  if srsym.typ=unitsym then
+                    unitsyms.add(upper(srsym.realname),srsym);
+                end;
             pu:=tused_unit(hmodule.used_units.first);
             while assigned(pu) do
               begin
                 if not assigned(pu.u.globalsymtable) then
                   internalerror(200705153);
                 symtablestack.push(pu.u.globalsymtable);
+                srsym:=tsym(unitsyms.find(pu.u.modulename^));
+                if assigned(srsym) and not assigned(tunitsym(srsym).module) then
+                  tunitsym(srsym).module:=pu.u;
                 pu:=tused_unit(pu.next);
               end;
+            unitsyms.free;
 
             if assigned(hmodule.globalsymtable) then
               symtablestack.push(hmodule.globalsymtable);

+ 17 - 0
compiler/psub.pas

@@ -1977,6 +1977,9 @@ implementation
         pu : tused_unit;
         hmodule : tmodule;
         specobj : tabstractrecorddef;
+        unitsyms : TFPHashObjectList;
+        sym : tsym;
+        i : Integer;
 
       procedure process_abstractrecorddef(def:tabstractrecorddef);
         var
@@ -2038,14 +2041,28 @@ implementation
         hmodule:=find_module_from_symtable(specobj.genericdef.owner);
         if hmodule=nil then
           internalerror(200705152);
+        { collect all unit syms in the generic's unit as we need to establish
+          their unitsym.module link again so that unit identifiers can be used }
+        unitsyms:=tfphashobjectlist.create(false);
+        if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
+          for i:=0 to hmodule.globalsymtable.symlist.count-1 do
+            begin
+              sym:=tsym(hmodule.globalsymtable.symlist[i]);
+              if sym.typ=unitsym then
+                unitsyms.add(upper(sym.realname),sym);
+            end;
         pu:=tused_unit(hmodule.used_units.first);
         while assigned(pu) do
           begin
             if not assigned(pu.u.globalsymtable) then
               internalerror(200705153);
             symtablestack.push(pu.u.globalsymtable);
+            sym:=tsym(unitsyms.find(pu.u.modulename^));
+            if assigned(sym) and not assigned(tunitsym(sym).module) then
+              tunitsym(sym).module:=pu.u;
             pu:=tused_unit(pu.next);
           end;
+        unitsyms.free;
         if assigned(hmodule.globalsymtable) then
           symtablestack.push(hmodule.globalsymtable);
         if assigned(hmodule.localsymtable) then

+ 15 - 0
tests/test/tgeneric74.pp

@@ -0,0 +1,15 @@
+{ %NORUN }
+{ %RECOMPILE }
+
+program tgeneric74;
+
+{$mode objfpc}
+
+uses
+  ugeneric74a;
+
+type
+  TSpezLongInt = specialize TGeneric<LongInt>;
+begin
+
+end.

+ 16 - 0
tests/test/tgeneric75.pp

@@ -0,0 +1,16 @@
+{ %NORUN }
+{ %RECOMPILE }
+
+program tgeneric75;
+
+{$mode objfpc}
+
+uses
+  ugeneric75;
+
+type
+  TSpezLongInt = specialize TGeneric<LongInt>;
+
+begin
+
+end.

+ 14 - 0
tests/test/ugeneric.test75.pp

@@ -0,0 +1,14 @@
+unit ugeneric.test75;
+
+interface
+
+procedure Test;
+
+implementation
+
+procedure Test;
+begin
+
+end;
+
+end.

+ 23 - 0
tests/test/ugeneric74a.pp

@@ -0,0 +1,23 @@
+unit ugeneric74a;
+
+{$mode objfpc}
+
+interface
+
+uses
+  ugeneric74b;
+
+type
+  generic TGeneric<T> = class
+    procedure Test;
+  end;
+
+implementation
+
+procedure TGeneric.Test;
+begin
+  ugeneric74b.Test;
+end;
+
+
+end.

+ 14 - 0
tests/test/ugeneric74b.pp

@@ -0,0 +1,14 @@
+unit ugeneric74b;
+
+interface
+
+procedure Test;
+
+implementation
+
+procedure Test;
+begin
+
+end;
+
+end.

+ 22 - 0
tests/test/ugeneric75.pp

@@ -0,0 +1,22 @@
+unit ugeneric75;
+
+{$mode objfpc}
+
+interface
+
+uses
+  ugeneric.test75;
+
+type
+  generic TGeneric<T> = class
+    procedure Test;
+  end;
+
+implementation
+
+procedure TGeneric.Test;
+begin
+  ugeneric.test75.Test;
+end;
+
+end.