From c572395f6197504470c0475cbf44e6884a1c7b96 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Sat, 4 Feb 2012 11:33:17 +0000 Subject: [PATCH] * 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 - --- .gitattributes | 6 ++++++ compiler/pgenutil.pas | 15 +++++++++++++++ compiler/psub.pas | 17 +++++++++++++++++ tests/test/tgeneric74.pp | 15 +++++++++++++++ tests/test/tgeneric75.pp | 16 ++++++++++++++++ tests/test/ugeneric.test75.pp | 14 ++++++++++++++ tests/test/ugeneric74a.pp | 23 +++++++++++++++++++++++ tests/test/ugeneric74b.pp | 14 ++++++++++++++ tests/test/ugeneric75.pp | 22 ++++++++++++++++++++++ 9 files changed, 142 insertions(+) create mode 100644 tests/test/tgeneric74.pp create mode 100644 tests/test/tgeneric75.pp create mode 100644 tests/test/ugeneric.test75.pp create mode 100644 tests/test/ugeneric74a.pp create mode 100644 tests/test/ugeneric74b.pp create mode 100644 tests/test/ugeneric75.pp diff --git a/.gitattributes b/.gitattributes index ee3d3f76ba..c96b5f29b7 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 51b41fe492..b09a588216 100644 --- a/compiler/pgenutil.pas +++ b/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); diff --git a/compiler/psub.pas b/compiler/psub.pas index f3d681889e..88e3e4f20d 100644 --- a/compiler/psub.pas +++ b/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 diff --git a/tests/test/tgeneric74.pp b/tests/test/tgeneric74.pp new file mode 100644 index 0000000000..0752210e50 --- /dev/null +++ b/tests/test/tgeneric74.pp @@ -0,0 +1,15 @@ +{ %NORUN } +{ %RECOMPILE } + +program tgeneric74; + +{$mode objfpc} + +uses + ugeneric74a; + +type + TSpezLongInt = specialize TGeneric; +begin + +end. diff --git a/tests/test/tgeneric75.pp b/tests/test/tgeneric75.pp new file mode 100644 index 0000000000..826ff57db3 --- /dev/null +++ b/tests/test/tgeneric75.pp @@ -0,0 +1,16 @@ +{ %NORUN } +{ %RECOMPILE } + +program tgeneric75; + +{$mode objfpc} + +uses + ugeneric75; + +type + TSpezLongInt = specialize TGeneric; + +begin + +end. diff --git a/tests/test/ugeneric.test75.pp b/tests/test/ugeneric.test75.pp new file mode 100644 index 0000000000..81cdacdb4b --- /dev/null +++ b/tests/test/ugeneric.test75.pp @@ -0,0 +1,14 @@ +unit ugeneric.test75; + +interface + +procedure Test; + +implementation + +procedure Test; +begin + +end; + +end. diff --git a/tests/test/ugeneric74a.pp b/tests/test/ugeneric74a.pp new file mode 100644 index 0000000000..3b68c94d51 --- /dev/null +++ b/tests/test/ugeneric74a.pp @@ -0,0 +1,23 @@ +unit ugeneric74a; + +{$mode objfpc} + +interface + +uses + ugeneric74b; + +type + generic TGeneric = class + procedure Test; + end; + +implementation + +procedure TGeneric.Test; +begin + ugeneric74b.Test; +end; + + +end. diff --git a/tests/test/ugeneric74b.pp b/tests/test/ugeneric74b.pp new file mode 100644 index 0000000000..786e44d1bf --- /dev/null +++ b/tests/test/ugeneric74b.pp @@ -0,0 +1,14 @@ +unit ugeneric74b; + +interface + +procedure Test; + +implementation + +procedure Test; +begin + +end; + +end. diff --git a/tests/test/ugeneric75.pp b/tests/test/ugeneric75.pp new file mode 100644 index 0000000000..492202f289 --- /dev/null +++ b/tests/test/ugeneric75.pp @@ -0,0 +1,22 @@ +unit ugeneric75; + +{$mode objfpc} + +interface + +uses + ugeneric.test75; + +type + generic TGeneric = class + procedure Test; + end; + +implementation + +procedure TGeneric.Test; +begin + ugeneric.test75.Test; +end; + +end.