mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 10:48:12 +02:00
* 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:
parent
76d29ff172
commit
c572395f61
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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
15
tests/test/tgeneric74.pp
Normal 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
16
tests/test/tgeneric75.pp
Normal file
@ -0,0 +1,16 @@
|
||||
{ %NORUN }
|
||||
{ %RECOMPILE }
|
||||
|
||||
program tgeneric75;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
ugeneric75;
|
||||
|
||||
type
|
||||
TSpezLongInt = specialize TGeneric<LongInt>;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
14
tests/test/ugeneric.test75.pp
Normal file
14
tests/test/ugeneric.test75.pp
Normal file
@ -0,0 +1,14 @@
|
||||
unit ugeneric.test75;
|
||||
|
||||
interface
|
||||
|
||||
procedure Test;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
23
tests/test/ugeneric74a.pp
Normal file
23
tests/test/ugeneric74a.pp
Normal 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
14
tests/test/ugeneric74b.pp
Normal file
@ -0,0 +1,14 @@
|
||||
unit ugeneric74b;
|
||||
|
||||
interface
|
||||
|
||||
procedure Test;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
22
tests/test/ugeneric75.pp
Normal file
22
tests/test/ugeneric75.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user