From 88af29315501096f8863644317fe1a8c890ceef4 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Tue, 25 Sep 2012 09:45:25 +0000
Subject: [PATCH] Fix for Mantis #22160
The cause of the internal error was the following:
We have a generic in an unit ("A") which uses another unit ("B") in the implementation section and this other unit uses unit A in the interface section. Now the generic is specialized in the interface section of B. This leads to the problem that in unit A when it tries to load the globalsymtable of unit B that globalsymtable will be Nil, because parsing of the interface section is not yet finished. Thus the change in pgenutil.pas, specialization_init: if the unit is still "in_interface" the localsymtable needs to be used instead of the globalsymtable.
This doesn't necessarily lead to a compiling test though, as there is the following possibility:
Unit A contains a generic class/record (with methods) and uses unit B in the implementation section. This unit B also contains a generic class/record (with methods) and uses unit A in the implementation section. Both units contain a specialization of the other unit's generic outside of it's own generics (such that generate_specialization is fully triggered). Let's assume compilation starts with unit A and we reach the uses of unit B. Now compilation switches to unit B and completes as unit A is already registered and in compilation. The problem now is that the generic in unit A still contains unresolved forward declarations as the implementation section of A was not yet parsed which will lead to "forward declaration not solved" errors (Note: Delphi compiles this).
The solution to this is the following: if a generic is specialized from another unit which is not in state ms_compiled then the unit of the specialization needs to wait for the unit of the generic. So the specialization's unit adds itself into a list of waiting units of the generic's unit. Now inside "proc_unit" we need to check whether this module is waiting for other modules and if so avoid "finishing" the unit (which means generating the methods of the specialization, generating assembler code and ultimately freeing the scanner and PPU). Now when the generic's unit finishes we need to check whether other modules are waiting for it and finish them (of course it's a bit more complicated in reality, but that pretty much sums it up).
+ globstat.pas: Added an unit which handles the saving and restoring of the global state which was originally inside "parser.pas, compile" so that Don't Repeat Yourself (DRY) is respected.
* fmodule.pas, tmodule:
+ add fields to keep track of the units the module is waiting for and which modules are waiting for the module
+ add field for the saved global state (raw pointer to avoid circles)
+ add field for the state which is needed to finish the unit (raw pointer to avoid circles)
+ move the code which was used in "parser.pas, compile" after a module was successfully compiled to the new virtual method "end_of_parsing"
+ fppu.pas, tppumodule.end_of_parsing:
free the ppufile here
* pgenutil.pas:
+ add new procedure "maybe_add_waiting_unit" which adds the specialization's unit to the waiting list of the generic if that unit is not yet compiled
* generate_specialization: call the new function when we add a new (true) specialization
* specialization_init: instead of not adding implementation units at all check whether the unit is still parsing the interface section and add the localsymtable in that case
* pmodules.pas:
* change "proc_unit" to a function which returns "true" if the unit was already finished (no need to wait for other units)
+ move the code from "proc_unit" from "generate_specialization_procs" on to a new procedure "finish_unit" which
* this procedure is either called immediately in "proc_unit" if the unit does not need to wait for other units or from "finish_unit" itself if a unit that is waiting for the given unit does no longer wait for another module (special care is taken in proc_unit to avoid circles)
* parser.pas, compile:
* correctly handle the case if an unit is not finished
* use the new global state functionality from globstat.pas
* pay special attention when calling "set_current_module" (see comment at that call)
+ add tests from 22160
+ add test for above mentioned "diamond" case
git-svn-id: trunk@22452 -
---
.gitattributes | 9 +++
compiler/fmodule.pas | 49 +++++++++++-
compiler/fppu.pas | 16 ++++
compiler/globstat.pas | 158 +++++++++++++++++++++++++++++++++++++
compiler/parser.pas | 154 +++++++++---------------------------
compiler/pgenutil.pas | 50 ++++++++++--
compiler/pmodules.pas | 160 +++++++++++++++++++++++++++++++-------
compiler/pp.lpi | 15 +++-
tests/test/tgeneric91.pp | 11 +++
tests/test/ugeneric91a.pp | 35 +++++++++
tests/test/ugeneric91b.pp | 35 +++++++++
tests/webtbs/tw22160a1.pp | 22 ++++++
tests/webtbs/tw22160b1.pp | 21 +++++
tests/webtbs/uw22160a2.pp | 14 ++++
tests/webtbs/uw22160b2.pp | 11 +++
tests/webtbs/uw22160b3.pp | 14 ++++
16 files changed, 616 insertions(+), 158 deletions(-)
create mode 100644 compiler/globstat.pas
create mode 100644 tests/test/tgeneric91.pp
create mode 100644 tests/test/ugeneric91a.pp
create mode 100644 tests/test/ugeneric91b.pp
create mode 100644 tests/webtbs/tw22160a1.pp
create mode 100644 tests/webtbs/tw22160b1.pp
create mode 100644 tests/webtbs/uw22160a2.pp
create mode 100644 tests/webtbs/uw22160b2.pp
create mode 100644 tests/webtbs/uw22160b3.pp
diff --git a/.gitattributes b/.gitattributes
index 92f78d3b90..777126bf0a 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -157,6 +157,7 @@ compiler/fppu.pas svneol=native#text/plain
compiler/gendef.pas svneol=native#text/plain
compiler/generic/cpuinfo.pas svneol=native#text/plain
compiler/globals.pas svneol=native#text/plain
+compiler/globstat.pas svneol=native#text/pascal
compiler/globtype.pas svneol=native#text/plain
compiler/hlcg2ll.pas svneol=native#text/plain
compiler/hlcgobj.pas svneol=native#text/plain
@@ -10816,6 +10817,7 @@ tests/test/tgeneric88.pp svneol=native#text/pascal
tests/test/tgeneric89.pp svneol=native#text/pascal
tests/test/tgeneric9.pp svneol=native#text/plain
tests/test/tgeneric90.pp svneol=native#text/pascal
+tests/test/tgeneric91.pp svneol=native#text/pascal
tests/test/tgoto.pp svneol=native#text/plain
tests/test/theap.pp svneol=native#text/plain
tests/test/theapthread.pp svneol=native#text/plain
@@ -11399,6 +11401,8 @@ 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/ugeneric91a.pp svneol=native#text/pascal
+tests/test/ugeneric91b.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
@@ -12837,6 +12841,8 @@ tests/webtbs/tw2210.pp svneol=native#text/plain
tests/webtbs/tw22133.pp svneol=native#text/plain
tests/webtbs/tw2214.pp svneol=native#text/plain
tests/webtbs/tw22154.pp svneol=native#text/pascal
+tests/webtbs/tw22160a1.pp svneol=native#text/pascal
+tests/webtbs/tw22160b1.pp svneol=native#text/pascal
tests/webtbs/tw2220.pp svneol=native#text/plain
tests/webtbs/tw2226.pp svneol=native#text/plain
tests/webtbs/tw2229.pp svneol=native#text/plain
@@ -13661,6 +13667,9 @@ tests/webtbs/uw20909b.pas svneol=native#text/pascal
tests/webtbs/uw20940.pp svneol=native#text/pascal
tests/webtbs/uw21808a.pp svneol=native#text/plain
tests/webtbs/uw21808b.pp svneol=native#text/plain
+tests/webtbs/uw22160a2.pp svneol=native#text/pascal
+tests/webtbs/uw22160b2.pp svneol=native#text/pascal
+tests/webtbs/uw22160b3.pp svneol=native#text/pascal
tests/webtbs/uw2266a.inc svneol=native#text/plain
tests/webtbs/uw2266b.pas svneol=native#text/plain
tests/webtbs/uw2269.inc svneol=native#text/plain
diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas
index 1d53b4fd02..d4b3aaf325 100644
--- a/compiler/fmodule.pas
+++ b/compiler/fmodule.pas
@@ -185,6 +185,17 @@ interface
tobjectdef instances (the helper defs) }
extendeddefs: TFPHashObjectList;
+ { this contains a list of units that needs to be waited for until the
+ unit can be finished (code generated, etc.); this is needed to handle
+ specializations in circular unit usages correctly }
+ waitingforunit: tfpobjectlist;
+ { this contains a list of all units that are waiting for this unit to be
+ finished }
+ waitingunits: tfpobjectlist;
+
+ finishstate: pointer;
+ globalstate: pointer;
+
namespace: pshortstring; { for JVM target: corresponds to Java package name }
{ for targets that initialise typed constants via explicit assignments
@@ -209,6 +220,7 @@ interface
function derefidx_unit(id:longint):longint;
function resolve_unit(id:longint):tmodule;
procedure allunitsused;
+ procedure end_of_parsing;virtual;
procedure setmodulename(const s:string);
procedure AddExternalImport(const libname,symname,symmangledname:string;OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
@@ -534,7 +546,9 @@ implementation
ansistrdef:=nil;
wpoinfo:=nil;
checkforwarddefs:=TFPObjectList.Create(false);
- extendeddefs := TFPHashObjectList.Create(true);
+ extendeddefs:=TFPHashObjectList.Create(true);
+ waitingforunit:=tfpobjectlist.create(false);
+ waitingunits:=tfpobjectlist.create(false);
globalsymtable:=nil;
localsymtable:=nil;
globalmacrosymtable:=nil;
@@ -622,6 +636,8 @@ implementation
stringdispose(mainname);
FImportLibraryList.Free;
extendeddefs.Free;
+ waitingforunit.free;
+ waitingunits.free;
stringdispose(asmprefix);
stringdispose(deprecatedmsg);
stringdispose(namespace);
@@ -962,6 +978,37 @@ implementation
end;
end;
+ procedure tmodule.end_of_parsing;
+ begin
+ { free asmdata }
+ if assigned(asmdata) then
+ begin
+ asmdata.free;
+ asmdata:=nil;
+ end;
+
+ { free scanner }
+ if assigned(scanner) then
+ begin
+ if current_scanner=tscannerfile(scanner) then
+ current_scanner:=nil;
+ tscannerfile(scanner).free;
+ scanner:=nil;
+ end;
+
+ { free symtable stack }
+ if assigned(symtablestack) then
+ begin
+ symtablestack.free;
+ symtablestack:=nil;
+ end;
+ if assigned(macrosymtablestack) then
+ begin
+ macrosymtablestack.free;
+ macrosymtablestack:=nil;
+ end;
+ end;
+
procedure tmodule.setmodulename(const s:string);
begin
diff --git a/compiler/fppu.pas b/compiler/fppu.pas
index fb16cc2bfe..b9507e6bc0 100644
--- a/compiler/fppu.pas
+++ b/compiler/fppu.pas
@@ -64,6 +64,7 @@ interface
function needrecompile:boolean;
procedure setdefgeneration;
procedure reload_flagged_units;
+ procedure end_of_parsing;override;
private
{ Each time a unit's defs are (re)created, its defsgeneration is
set to the value of a global counter, and the global counter is
@@ -1493,6 +1494,21 @@ var
end;
end;
+ procedure tppumodule.end_of_parsing;
+ begin
+ { module is now compiled }
+ state:=ms_compiled;
+
+ { free ppu }
+ if assigned(ppufile) then
+ begin
+ ppufile.free;
+ ppufile:=nil;
+ end;
+
+ inherited end_of_parsing;
+ end;
+
procedure tppumodule.loadppu;
const
diff --git a/compiler/globstat.pas b/compiler/globstat.pas
new file mode 100644
index 0000000000..124a9f0d8c
--- /dev/null
+++ b/compiler/globstat.pas
@@ -0,0 +1,158 @@
+{
+ Copyright (c) 2012 by the FPC development team
+
+ Contains functionality to save/restore the global compiler state when
+ switching between the compilation of different units.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit globstat;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+ globtype,tokens,globals,
+ aasmdata,
+ dbgbase,
+ symbase,symsym,
+ fmodule,
+ scanner,scandir,
+ procinfo;
+
+
+type
+ pglobalstate=^tglobalstate;
+ tglobalstate=record
+ { scanner }
+ oldidtoken,
+ oldtoken : ttoken;
+ oldtokenpos : tfileposinfo;
+ oldc : char;
+ oldpattern,
+ oldorgpattern : string;
+ old_block_type : tblock_type;
+ { symtable }
+ oldsymtablestack,
+ oldmacrosymtablestack : TSymtablestack;
+ oldaktprocsym : tprocsym;
+ { cg }
+ oldparse_only : boolean;
+ { akt.. things }
+ oldcurrent_filepos : tfileposinfo;
+ old_current_module : tmodule;
+ oldcurrent_procinfo : tprocinfo;
+ old_settings : tsettings;
+ old_switchesstatestack : tswitchesstatestack;
+ old_switchesstatestackpos : Integer;
+
+ { only saved/restored if "full" is true }
+ old_asmdata : tasmdata;
+ old_debuginfo : tdebuginfo;
+ old_scanner : tscannerfile;
+ old_parser_file : string;
+ end;
+
+procedure save_global_state(out state:tglobalstate;full:boolean);
+procedure restore_global_state(const state:tglobalstate;full:boolean);
+
+implementation
+
+uses
+ pbase;
+
+ procedure save_global_state(out state:tglobalstate;full:boolean);
+ begin
+ with state do
+ begin
+ old_current_module:=current_module;
+
+ { save symtable state }
+ oldsymtablestack:=symtablestack;
+ oldmacrosymtablestack:=macrosymtablestack;
+ oldcurrent_procinfo:=current_procinfo;
+
+ { save scanner state }
+ oldc:=c;
+ oldpattern:=pattern;
+ oldorgpattern:=orgpattern;
+ oldtoken:=token;
+ oldidtoken:=idtoken;
+ old_block_type:=block_type;
+ oldtokenpos:=current_tokenpos;
+ old_switchesstatestack:=switchesstatestack;
+ old_switchesstatestackpos:=switchesstatestackpos;
+
+ { save cg }
+ oldparse_only:=parse_only;
+
+ { save akt... state }
+ { handle the postponed case first }
+ //flushpendingswitchesstate;
+ oldcurrent_filepos:=current_filepos;
+ old_settings:=current_settings;
+
+ if full then
+ begin
+ old_asmdata:=current_asmdata;
+ old_debuginfo:=current_debuginfo;
+ old_parser_file:=parser_current_file;
+ old_scanner:=current_scanner;
+ end;
+ end;
+ end;
+
+
+ procedure restore_global_state(const state:tglobalstate;full:boolean);
+ begin
+ with state do
+ begin
+ { restore scanner }
+ c:=oldc;
+ pattern:=oldpattern;
+ orgpattern:=oldorgpattern;
+ token:=oldtoken;
+ idtoken:=oldidtoken;
+ current_tokenpos:=oldtokenpos;
+ block_type:=old_block_type;
+ switchesstatestack:=old_switchesstatestack;
+ switchesstatestackpos:=old_switchesstatestackpos;
+
+ { restore cg }
+ parse_only:=oldparse_only;
+
+ { restore symtable state }
+ symtablestack:=oldsymtablestack;
+ macrosymtablestack:=oldmacrosymtablestack;
+ current_procinfo:=oldcurrent_procinfo;
+ current_filepos:=oldcurrent_filepos;
+ current_settings:=old_settings;
+
+ if full then
+ begin
+ current_module:=old_current_module; {!}
+ current_asmdata:=old_asmdata;
+ current_debuginfo:=old_debuginfo;
+ current_scanner:=old_scanner;
+ parser_current_file:=old_parser_file;
+ end;
+ end;
+ end;
+
+end.
+
diff --git a/compiler/parser.pas b/compiler/parser.pas
index 56a2a5cfdf..7a14e23bb6 100644
--- a/compiler/parser.pas
+++ b/compiler/parser.pas
@@ -41,7 +41,7 @@ implementation
fksysutl,
{$ENDIF}
cutils,cclasses,
- globtype,version,tokens,systems,globals,verbose,switches,
+ globtype,version,tokens,systems,globals,verbose,switches,globstat,
symbase,symtable,symdef,symsym,
finput,fmodule,fppu,
aasmbase,aasmtai,aasmdata,
@@ -259,35 +259,10 @@ implementation
*****************************************************************************}
procedure compile(const filename:string);
- type
- polddata=^tolddata;
- tolddata=record
- { scanner }
- oldidtoken,
- oldtoken : ttoken;
- oldtokenpos : tfileposinfo;
- oldc : char;
- oldpattern,
- oldorgpattern : string;
- old_block_type : tblock_type;
- { symtable }
- oldsymtablestack,
- oldmacrosymtablestack : TSymtablestack;
- oldaktprocsym : tprocsym;
- { cg }
- oldparse_only : boolean;
- { akt.. things }
- oldcurrent_filepos : tfileposinfo;
- old_current_module : tmodule;
- oldcurrent_procinfo : tprocinfo;
- old_settings : tsettings;
- old_switchesstatestack : tswitchesstatestack;
- old_switchesstatestackpos : Integer;
- end;
-
var
- olddata : polddata;
+ olddata : pglobalstate;
hp,hp2 : tmodule;
+ finished : boolean;
begin
{ parsing a procedure or declaration should be finished }
if assigned(current_procinfo) then
@@ -300,35 +275,9 @@ implementation
stack. This is needed because compile() can be called
recursively }
new(olddata);
- with olddata^ do
- begin
- old_current_module:=current_module;
-
- { save symtable state }
- oldsymtablestack:=symtablestack;
- oldmacrosymtablestack:=macrosymtablestack;
- oldcurrent_procinfo:=current_procinfo;
-
- { save scanner state }
- oldc:=c;
- oldpattern:=pattern;
- oldorgpattern:=orgpattern;
- oldtoken:=token;
- oldidtoken:=idtoken;
- old_block_type:=block_type;
- oldtokenpos:=current_tokenpos;
- old_switchesstatestack:=switchesstatestack;
- old_switchesstatestackpos:=switchesstatestackpos;
-
- { save cg }
- oldparse_only:=parse_only;
-
- { save akt... state }
- { handle the postponed case first }
- flushpendingswitchesstate;
- oldcurrent_filepos:=current_filepos;
- old_settings:=current_settings;
- end;
+ { handle the postponed case first }
+ flushpendingswitchesstate;
+ save_global_state(olddata^,false);
{ reset parser, a previous fatal error could have left these variables in an unreliable state, this is
important for the IDE }
@@ -385,6 +334,9 @@ implementation
{ read the first token }
current_scanner.readtoken(false);
+ { this is set to false if a unit needs to wait for other units }
+ finished:=true;
+
{ If the compile level > 1 we get a nice "unit expected" error
message if we are trying to use a program as unit.}
try
@@ -392,7 +344,7 @@ implementation
if (token=_UNIT) or (compile_level>1) then
begin
current_module.is_unit:=true;
- proc_unit;
+ finished:=proc_unit;
end
else if (token=_ID) and (idtoken=_PACKAGE) then
begin
@@ -412,45 +364,24 @@ implementation
raise;
end;
end;
+
+ { the program or the unit at the command line should not need to wait
+ for other units }
+ if (compile_level=1) and not finished then
+ internalerror(2012091901);
finally
if assigned(current_module) then
begin
- { module is now compiled }
- tppumodule(current_module).state:=ms_compiled;
-
- { free ppu }
- if assigned(tppumodule(current_module).ppufile) then
+ if finished then
+ current_module.end_of_parsing
+ else
begin
- tppumodule(current_module).ppufile.free;
- tppumodule(current_module).ppufile:=nil;
- end;
-
- { free asmdata }
- if assigned(current_module.asmdata) then
- begin
- current_module.asmdata.free;
- current_module.asmdata:=nil;
- end;
-
- { free scanner }
- if assigned(current_module.scanner) then
- begin
- if current_scanner=tscannerfile(current_module.scanner) then
- current_scanner:=nil;
- tscannerfile(current_module.scanner).free;
- current_module.scanner:=nil;
- end;
-
- { free symtable stack }
- if assigned(symtablestack) then
- begin
- symtablestack.free;
- symtablestack:=nil;
- end;
- if assigned(macrosymtablestack) then
- begin
- macrosymtablestack.free;
+ { these are saved in the unit's state and thus can be set to
+ Nil again as would be done by tmodule.end_of_parsing }
macrosymtablestack:=nil;
+ symtablestack:=nil;
+ if current_scanner=current_module.scanner then
+ current_scanner:=nil;
end;
end;
@@ -459,33 +390,13 @@ implementation
{ Write Browser Collections }
do_extractsymbolinfo;
- with olddata^ do
- begin
- { restore scanner }
- c:=oldc;
- pattern:=oldpattern;
- orgpattern:=oldorgpattern;
- token:=oldtoken;
- idtoken:=oldidtoken;
- current_tokenpos:=oldtokenpos;
- block_type:=old_block_type;
- switchesstatestack:=old_switchesstatestack;
- switchesstatestackpos:=old_switchesstatestackpos;
+ restore_global_state(olddata^,false);
- { restore cg }
- parse_only:=oldparse_only;
+ { Restore all locally modified warning messages }
+ RestoreLocalVerbosity(current_settings.pmessage);
+ current_exceptblock:=0;
+ exceptblockcounter:=0;
- { restore symtable state }
- symtablestack:=oldsymtablestack;
- macrosymtablestack:=oldmacrosymtablestack;
- current_procinfo:=oldcurrent_procinfo;
- current_filepos:=oldcurrent_filepos;
- current_settings:=old_settings;
- { Restore all locally modified warning messages }
- RestoreLocalVerbosity(current_settings.pmessage);
- current_exceptblock:=0;
- exceptblockcounter:=0;
- end;
{ Shut down things when the last file is compiled succesfull }
if (compile_level=1) and
(status.errorcount=0) then
@@ -518,7 +429,14 @@ implementation
unloaded_units.Clear;
end;
dec(compile_level);
- set_current_module(olddata^.old_current_module);
+ { If used units are compiled current_module is already the same as
+ the stored module. Now if the unit is not finished its scanner is
+ not yet freed and thus set_current_module would reopen the scanned
+ file which will result in pointing to the wrong position in the
+ file. In the normal case current_scanner and current_module.scanner
+ would be Nil, thus nothing bad would happen }
+ if olddata^.old_current_module<>current_module then
+ set_current_module(olddata^.old_current_module);
FreeLocalVerbosity(current_settings.pmessage);
diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas
index f7c62e79ac..230b870160 100644
--- a/compiler/pgenutil.pas
+++ b/compiler/pgenutil.pas
@@ -56,7 +56,7 @@ uses
{ common }
cutils,fpccrc,
{ global }
- globals,tokens,verbose,
+ globals,tokens,verbose,finput,
{ symtable }
symconst,symsym,symtable,
{ modules }
@@ -69,6 +69,34 @@ uses
pbase,pexpr,pdecsub,ptype;
+ procedure maybe_add_waiting_unit(tt:tdef);
+ var
+ hmodule : tmodule;
+ begin
+ if not assigned(tt) or
+ not (df_generic in tt.defoptions) then
+ exit;
+
+ hmodule:=find_module_from_symtable(tt.owner);
+ if not assigned(hmodule) then
+ internalerror(2012092401);
+
+ if hmodule=current_module then
+ exit;
+
+ if hmodule.state<>ms_compiled then
+ begin
+{$ifdef DEBUG_UNITWAITING}
+ Writeln('Unit ', current_module.modulename^,
+ ' waiting for ', hmodule.modulename^);
+{$endif DEBUG_UNITWAITING}
+ if current_module.waitingforunit.indexof(hmodule)<0 then
+ current_module.waitingforunit.add(hmodule);
+ if hmodule.waitingunits.indexof(current_module)<0 then
+ hmodule.waitingunits.add(current_module);
+ end;
+ end;
+
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
var
st : TSymtable;
@@ -375,6 +403,8 @@ uses
current_specializedef:=nil;
end;
+ maybe_add_waiting_unit(genericdef);
+
{ First a new typesym so we can reuse this specialization and
references to this specialization can be handled }
srsym:=ttypesym.create(finalspecializename,generrordef);
@@ -696,14 +726,18 @@ uses
pu:=tused_unit(hmodule.used_units.first);
while assigned(pu) do
begin
- if (hmodule<>current_module) and not pu.in_interface then
- begin
- pu:=tused_unit(pu.next);
- continue;
- end;
if not assigned(pu.u.globalsymtable) then
- internalerror(200705153);
- symtablestack.push(pu.u.globalsymtable);
+ { in certain circular, but valid unit constellations it can happen
+ that we specialize a generic in a different unit that was used
+ in the implementation section of the generic's unit and were the
+ interface is still being parsed and thus the localsymtable is in
+ reality the global symtable }
+ if pu.u.in_interface then
+ symtablestack.push(pu.u.localsymtable)
+ else
+ internalerror(200705153)
+ else
+ 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;
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index 9d5b49c7ef..6ae5fd6e13 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -25,7 +25,7 @@ unit pmodules;
interface
- procedure proc_unit;
+ function proc_unit:boolean;
procedure proc_package;
procedure proc_program(islibrary : boolean);
@@ -35,7 +35,7 @@ implementation
SysUtils,
globtype,version,systems,tokens,
cutils,cfileutl,cclasses,comphook,
- globals,verbose,fmodule,finput,fppu,
+ globals,verbose,fmodule,finput,fppu,globstat,
symconst,symbase,symtype,symdef,symsym,symtable,symcreat,
wpoinfo,
aasmtai,aasmdata,aasmcpu,aasmbase,
@@ -725,44 +725,34 @@ implementation
end;
{$endif jvm}
- procedure proc_unit;
+type
+ tfinishstate=record
+ init_procinfo:tcgprocinfo;
+ end;
+ pfinishstate=^tfinishstate;
- function is_assembler_generated:boolean;
- var
- hal : tasmlisttype;
- begin
- result:=false;
- if Errorcount=0 then
- begin
- for hal:=low(TasmlistType) to high(TasmlistType) do
- if not current_asmdata.asmlists[hal].empty then
- begin
- result:=true;
- exit;
- end;
- end;
- end;
+ procedure finish_unit(module:tmodule;immediate:boolean);forward;
+ function proc_unit:boolean;
var
main_file: tinputfile;
+ {
{$ifdef EXTDEBUG}
store_crc,
{$endif EXTDEBUG}
store_interface_crc,
- store_indirect_crc: cardinal;
+ store_indirect_crc: cardinal;}
s1,s2 : ^string; {Saves stack space}
- force_init_final : boolean;
- init_procinfo,
- finalize_procinfo : tcgprocinfo;
+ init_procinfo : tcgprocinfo;
unitname : ansistring;
unitname8 : string[8];
- ag: boolean;
-{$ifdef debug_devirt}
- i: longint;
-{$endif debug_devirt}
+ i,j : longint;
+ finishstate:pfinishstate;
+ globalstate:pglobalstate;
begin
+ result:=true;
+
init_procinfo:=nil;
- finalize_procinfo:=nil;
if m_mac in current_settings.modeswitches then
current_module.mode_switch_allowed:= false;
@@ -962,6 +952,99 @@ implementation
current_module.mainfilepos:=init_procinfo.entrypos;
end;
+ { remove all units that we are waiting for that are already waiting for
+ us => breaking up circles }
+ for i:=0 to current_module.waitingunits.count-1 do
+ for j:=current_module.waitingforunit.count-1 downto 0 do
+ if current_module.waitingunits[i]=current_module.waitingforunit[j] then
+ current_module.waitingforunit.delete(j);
+
+{$ifdef DEBUG_UNITWAITING}
+ Writeln('Units waiting for ', current_module.modulename^, ': ',
+ current_module.waitingforunit.Count);
+{$endif}
+ result:=current_module.waitingforunit.count=0;
+
+ { save all information that is needed for finishing the unit }
+ New(finishstate);
+ finishstate^.init_procinfo:=init_procinfo;
+ current_module.finishstate:=finishstate;
+
+ if result then
+ finish_unit(current_module,true)
+ else
+ begin
+ { save the current state, so the parsing can continue where we left
+ of here }
+ New(globalstate);
+ save_global_state(globalstate^,true);
+ current_module.globalstate:=globalstate;
+ end;
+ end;
+
+ procedure finish_unit(module:tmodule;immediate:boolean);
+
+ function is_assembler_generated:boolean;
+ var
+ hal : tasmlisttype;
+ begin
+ result:=false;
+ if Errorcount=0 then
+ begin
+ for hal:=low(TasmlistType) to high(TasmlistType) do
+ if not current_asmdata.asmlists[hal].empty then
+ begin
+ result:=true;
+ exit;
+ end;
+ end;
+ end;
+
+ procedure module_is_done;inline;
+ begin
+ dispose(pglobalstate(current_module.globalstate));
+ current_module.globalstate:=nil;
+ dispose(pfinishstate(current_module.finishstate));
+ current_module.finishstate:=nil;
+ end;
+
+ var
+{$ifdef EXTDEBUG}
+ store_crc,
+{$endif EXTDEBUG}
+ store_interface_crc,
+ store_indirect_crc: cardinal;
+ force_init_final : boolean;
+ init_procinfo,
+ finalize_procinfo : tcgprocinfo;
+ i,idx : longint;
+ ag : boolean;
+ finishstate : tfinishstate;
+ globalstate : tglobalstate;
+ waitingmodule : tmodule;
+ begin
+ if not immediate then
+ begin
+{$ifdef DEBUG_UNITWAITING}
+ writeln('finishing waiting unit ''', module.modulename^, '''');
+{$endif DEBUG_UNITWAITING}
+ { restore the state when we stopped working on the unit }
+ save_global_state(globalstate,true);
+ if not assigned(module.globalstate) then
+ internalerror(2012091802);
+ restore_global_state(pglobalstate(module.globalstate)^,true);
+ end;
+
+ { current_module is now module }
+
+ if not assigned(current_module.finishstate) then
+ internalerror(2012091801);
+ finishstate:=pfinishstate(current_module.finishstate)^;
+
+ finalize_procinfo:=nil;
+
+ init_procinfo:=finishstate.init_procinfo;
+
{ Generate specializations of objectdefs methods }
generate_specialization_procs;
@@ -1061,6 +1144,9 @@ implementation
begin
Message1(unit_f_errors_in_unit,tostr(Errorcount));
status.skip_error:=true;
+ module_is_done;
+ if not immediate then
+ restore_global_state(globalstate,true);
exit;
end;
@@ -1148,6 +1234,9 @@ implementation
begin
Message1(unit_f_errors_in_unit,tostr(Errorcount));
status.skip_error:=true;
+ module_is_done;
+ if not immediate then
+ restore_global_state(globalstate,true);
exit;
end;
@@ -1190,6 +1279,23 @@ implementation
{$endif debug_devirt}
Message1(unit_u_finished_compiling,current_module.modulename^);
+
+ module_is_done;
+ if not immediate then
+ restore_global_state(globalstate,true);
+
+ for i:=0 to module.waitingunits.count-1 do
+ begin
+ waitingmodule:=tmodule(module.waitingunits[i]);
+ waitingmodule.waitingforunit.remove(module);
+ { only finish the module if it isn't already finished }
+ if (waitingmodule.waitingforunit.count=0) and
+ assigned(waitingmodule.finishstate) then
+ begin
+ finish_unit(waitingmodule,false);
+ waitingmodule.end_of_parsing;
+ end;
+ end;
end;
diff --git a/compiler/pp.lpi b/compiler/pp.lpi
index e6f1afe1ab..9788239ca8 100644
--- a/compiler/pp.lpi
+++ b/compiler/pp.lpi
@@ -25,11 +25,12 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
- <CommandLineParams Value="-MObjFPC -Scgi -O1 -gl -vewnhi -l -FiD:\programming\laz_svn\fpc_features\cpstr\lib\i386-win32\ -FuD:\programming\laz_svn\cpstr\cpstrnew\ -Fu. -FUD:\programming\laz_svn\fpc_features\cpstr\lib\i386-win32\ -oproject1.exe D:\programming\laz_svn\fpc_features\cpstr\project1.lpr"/>
+ <CommandLineParams Value="-n -Furtl\units\i386-win32 -viwn -FEtestoutput fpctests\tgenunitstatic.pas"/>
<LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <WorkingDirectory Value="c:\svn\fpc"/>
</local>
</RunParams>
- <Units Count="2">
+ <Units Count="3">
<Unit0>
<Filename Value="pp.pas"/>
<IsPartOfProject Value="True"/>
@@ -40,6 +41,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="aasmcpu"/>
</Unit1>
+ <Unit2>
+ <Filename Value="globstat.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="globstat"/>
+ </Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
@@ -63,7 +69,7 @@
</Parsing>
<Linking>
<Debugging>
- <DebugInfoType Value="dsStabs"/>
+ <DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
</Linking>
<Other>
@@ -78,7 +84,8 @@
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
- <CustomOptions Value="-di386"/>
+ <CustomOptions Value="-di386
+-dDEBUG_UNITWAITING"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
diff --git a/tests/test/tgeneric91.pp b/tests/test/tgeneric91.pp
new file mode 100644
index 0000000000..077f315dcf
--- /dev/null
+++ b/tests/test/tgeneric91.pp
@@ -0,0 +1,11 @@
+{ %NORUN }
+
+program tgeneric91;
+
+uses
+ ugeneric91a,ugeneric91b;
+
+begin
+ TSomeClass1.Test;
+ TSomeClass2.Test;
+end.
diff --git a/tests/test/ugeneric91a.pp b/tests/test/ugeneric91a.pp
new file mode 100644
index 0000000000..3594199b96
--- /dev/null
+++ b/tests/test/ugeneric91a.pp
@@ -0,0 +1,35 @@
+unit ugeneric91a;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+ generic TSomeGeneric1<T> = class
+ class procedure Test;
+ end;
+
+ TSomeClass1 = class
+ class procedure Test;
+ end;
+
+implementation
+
+uses
+ ugeneric91b;
+
+type
+ TSomeGeneric2LongInt = specialize TSomeGeneric2<LongInt>;
+
+class procedure TSomeClass1.Test;
+begin
+ TSomeGeneric2LongInt.Test;
+end;
+
+class procedure TSomeGeneric1.Test;
+begin
+ Writeln(Self.ClassName);
+end;
+
+end.
+
diff --git a/tests/test/ugeneric91b.pp b/tests/test/ugeneric91b.pp
new file mode 100644
index 0000000000..874b9ac745
--- /dev/null
+++ b/tests/test/ugeneric91b.pp
@@ -0,0 +1,35 @@
+unit ugeneric91b;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+ generic TSomeGeneric2<T> = class
+ class procedure Test;
+ end;
+
+ TSomeClass2 = class
+ class procedure Test;
+ end;
+
+implementation
+
+uses
+ ugeneric91a;
+
+type
+ TSomeGeneric1LongInt = specialize TSomeGeneric1<LongInt>;
+
+class procedure TSomeClass2.Test;
+begin
+ TSomeGeneric1LongInt.Test;
+end;
+
+class procedure TSomeGeneric2.Test;
+begin
+ Writeln(Self.ClassName);
+end;
+
+end.
+
diff --git a/tests/webtbs/tw22160a1.pp b/tests/webtbs/tw22160a1.pp
new file mode 100644
index 0000000000..bb99600331
--- /dev/null
+++ b/tests/webtbs/tw22160a1.pp
@@ -0,0 +1,22 @@
+unit tw22160a1;
+
+{$mode delphi}
+
+interface
+
+type
+ TWrapper<T> = class
+ procedure Z;
+ end;
+
+implementation
+
+uses uw22160a2;
+
+{ TWrapper<T> }
+
+procedure TWrapper<T>.Z;
+begin
+end;
+
+end.
diff --git a/tests/webtbs/tw22160b1.pp b/tests/webtbs/tw22160b1.pp
new file mode 100644
index 0000000000..0dcf6fface
--- /dev/null
+++ b/tests/webtbs/tw22160b1.pp
@@ -0,0 +1,21 @@
+unit tw22160b1;
+
+{$mode delphi}
+
+interface
+
+type
+ TWrapper<T> = class
+ procedure Test;
+ end;
+
+implementation
+
+uses uw22160b2;
+
+procedure TWrapper<T>.Test;
+begin
+
+end;
+
+end.
diff --git a/tests/webtbs/uw22160a2.pp b/tests/webtbs/uw22160a2.pp
new file mode 100644
index 0000000000..e8bd40ec99
--- /dev/null
+++ b/tests/webtbs/uw22160a2.pp
@@ -0,0 +1,14 @@
+unit uw22160a2;
+
+{$mode delphi}
+
+interface
+
+uses tw22160a1;
+
+implementation
+
+type
+ TByteWrapper = TWrapper<Byte>;
+
+end.
diff --git a/tests/webtbs/uw22160b2.pp b/tests/webtbs/uw22160b2.pp
new file mode 100644
index 0000000000..456e23a9c4
--- /dev/null
+++ b/tests/webtbs/uw22160b2.pp
@@ -0,0 +1,11 @@
+unit uw22160b2;
+
+{$mode delphi}
+
+interface
+
+uses uw22160b3;
+
+implementation
+
+end.
diff --git a/tests/webtbs/uw22160b3.pp b/tests/webtbs/uw22160b3.pp
new file mode 100644
index 0000000000..32fe12f88a
--- /dev/null
+++ b/tests/webtbs/uw22160b3.pp
@@ -0,0 +1,14 @@
+unit uw22160b3;
+
+{$mode delphi}
+
+interface
+
+uses tw22160b1;
+
+type
+ TByteWrapper = TWrapper<Byte>;
+
+implementation
+
+end.