paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 14:49:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix for Mantis #22160

Browse Source 
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 -
This commit is contained in:
svenbarth 2012-09-25 09:45:25 +00:00
parent d01ec10f45
commit 88af293155
16 changed files with 616 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitattributes vendored
View File

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

49
compiler/fmodule.pas
View File

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

16
compiler/fppu.pas
View File

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

158
compiler/globstat.pas Normal file
View File

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

154
compiler/parser.pas
View File

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

50
compiler/pgenutil.pas
View File

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

160
compiler/pmodules.pas
View File

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

15
compiler/pp.lpi
View File

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

11
tests/test/tgeneric91.pp Normal file
View File

@ -0,0 +1,11 @@
{ %NORUN }
program tgeneric91;
uses
ugeneric91a,ugeneric91b;
begin
TSomeClass1.Test;
TSomeClass2.Test;
end.

35
tests/test/ugeneric91a.pp Normal file
View File

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

35
tests/test/ugeneric91b.pp Normal file
View File

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

22
tests/webtbs/tw22160a1.pp Normal file
View File

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

21
tests/webtbs/tw22160b1.pp Normal file
View File

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

14
tests/webtbs/uw22160a2.pp Normal file
View File

@ -0,0 +1,14 @@
unit uw22160a2;
{$mode delphi}
interface
uses tw22160a1;
implementation
type
TByteWrapper = TWrapper<Byte>;
end.

11
tests/webtbs/uw22160b2.pp Normal file
View File

@ -0,0 +1,11 @@
unit uw22160b2;
{$mode delphi}
interface
uses uw22160b3;
implementation
end.

14
tests/webtbs/uw22160b3.pp Normal file
View File

@ -0,0 +1,14 @@
unit uw22160b3;
{$mode delphi}
interface
uses tw22160b1;
type
TByteWrapper = TWrapper<Byte>;
implementation
end.