* 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 -
This commit is contained in:
svenbarth 2012-02-04 11:33:17 +00:00
parent 76d29ff172
commit c572395f61
9 changed files with 142 additions and 0 deletions

6
.gitattributes vendored
View File

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

View File

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

View File

@ -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
tests/test/tgeneric74.pp Normal file
View File

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

16
tests/test/tgeneric75.pp Normal file
View File

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

View File

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

23
tests/test/ugeneric74a.pp Normal file
View File

@ -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
tests/test/ugeneric74b.pp Normal file
View File

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

22
tests/test/ugeneric75.pp Normal file
View File

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