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

* Properly handle finish state

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-20 10:34:32 +01:00 committed by Michael Van Canneyt
parent 42c9eb4096
commit 6ac14de986
5 changed files with 57 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/ctask.pas
View File

@ -191,7 +191,7 @@ function ttask_handler.cancontinue(m: tmodule; checksub : boolean; out firstwait
itm:=m.used_units.First;
while (acandidate=Nil) and assigned(itm) do
begin
iscandidate:=Not (tused_unit(itm).u.state in [ms_compiled]);
iscandidate:=Not (tused_unit(itm).u.state in [ms_processed,ms_compiled]);
if iscandidate then
begin
acandidate:=tused_unit(itm).u;
@ -207,28 +207,29 @@ var
begin
firstwaiting:=nil;
if m.is_initial and (list.count>1) then
// We do not need to consider the program as long as there are units that need to be treated.
if (m.is_initial and not m.is_unit) and (list.count>1) then
exit(False);
case m.state of
ms_unknown : cancontinue:=true;
ms_registered : cancontinue:=true;
ms_compile : cancontinue:=true;
ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false,firstwaiting);
ms_compiling_waitfinish : cancontinue:=m.nowaitingforunits;
ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true,firstwaiting);
ms_compiling_wait : cancontinue:=m.usedunitsloaded(true,firstwaiting);
ms_compiled : cancontinue:=true;
ms_processed : cancontinue:=true;
ms_moduleerror : cancontinue:=true;
else
InternalError(2024011802);
case m.state of
ms_unknown : cancontinue:=true;
ms_registered : cancontinue:=true;
ms_compile : cancontinue:=true;
ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false,firstwaiting);
ms_compiling_waitfinish : cancontinue:=m.nowaitingforunits;
ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true,firstwaiting);
ms_compiling_wait : cancontinue:=m.usedunitsloaded(true,firstwaiting);
ms_compiled : cancontinue:=true;
ms_processed : cancontinue:=true;
ms_moduleerror : cancontinue:=true;
else
InternalError(2024011802);
end;
if (not cancontinue) and checksub then
begin
checkused(m2);
if m2<>nil then
firstwaiting:=m2;
end;
if (not cancontinue) and checksub then
begin
checkused(m2);
if m2<>nil then
firstwaiting:=m2;
end;
end;
function ttask_handler.cancontinue(t : ttask_list; out firstwaiting : tmodule): boolean;
@ -254,7 +255,7 @@ begin
(m as tppumodule).post_load_or_compile(m.compilecount>1);
ms_compiling_waitintf : pmodules.parse_unit_interface_declarations(m);
ms_compiling_waitimpl : pmodules.proc_unit_implementation(m);
ms_compiling_waitfinish : pmodules.proc_unit_implementation(m);
ms_compiling_waitfinish : pmodules.finish_unit(m);
ms_compiling_wait : pmodules.proc_program_declarations(m,m.islibrary);
ms_processed : ;
else
@ -313,6 +314,8 @@ begin
begin
t:=t.nexttask;
end;
if t=nil then
t:=list.firsttask;
end;
end;

3
compiler/fmodule.pas
View File

@ -229,7 +229,6 @@ interface
waitingunits: tfpobjectlist;
finishstate: pointer;
globalstate: tobject;
namespace: pshortstring; { for JVM target: corresponds to Java package name }
@ -1041,7 +1040,7 @@ implementation
function tmodule.usedunitsloaded(interface_units : boolean; out firstwaiting : tmodule): boolean;
const
statesneeded : array[boolean] of tmodulestates = ([ms_processed, ms_compiled,ms_compiling_waitimpl],
statesneeded : array[boolean] of tmodulestates = ([ms_processed, ms_compiled,ms_compiling_waitimpl, ms_compiling_waitfinish],
[ms_processed, ms_compiled,ms_compiling_waitimpl]);
var

21
compiler/pbase.pas
View File

@ -76,6 +76,10 @@ interface
{ a syntax error is written }
procedure consume(i : ttoken);
{ Same as consume, but will not attempt to read next token if the token is a point }
procedure consume_last_dot;
{Tries to consume the token i, and returns true if it was consumed:
if token=i.}
function try_to_consume(i:Ttoken):boolean;
@ -144,8 +148,10 @@ implementation
{ consumes token i, write error if token is different }
procedure consume(i : ttoken);
begin
begin
if (token<>i) and (idtoken<>i) then
if token=_id then
Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
@ -159,6 +165,19 @@ implementation
end;
end;
procedure consume_last_dot;
begin
if (token<>_POINT) then
begin
if token=_id then
Message2(scan_f_syn_expected,tokeninfo^[_POINT].str,'identifier '+pattern)
else
Message2(scan_f_syn_expected,tokeninfo^[_POINT].str,tokeninfo^[token].str)
end
else if c<>#0 then
current_scanner.readtoken(true);
end;
function try_to_consume(i:Ttoken):boolean;
begin

5
compiler/pgenutil.pas
View File

@ -2889,6 +2889,8 @@ uses
def : tstoreddef;
state : tspecializationstate;
hmodule : tmodule;
mstate : tmodulestate;
begin
{ first copy all entries and then work with that list to ensure that
we don't get an infinite recursion }
@ -2920,7 +2922,8 @@ uses
{ we need to check for a forward declaration only if the
generic was declared in the same unit (otherwise there
should be one) }
if ((hmodule=current_module) or (hmodule.state=ms_compile)) and tprocdef(def.genericdef).forwarddef then
mstate:=hmodule.state;
if ((hmodule=current_module) or (hmodule.state<ms_compiling_waitfinish)) and tprocdef(def.genericdef).forwarddef then
begin
readdlist.add(def);
continue;

43
compiler/pmodules.pas
View File

@ -33,7 +33,7 @@ uses fmodule;
function proc_package(curr: tmodule) : boolean;
function proc_program(curr: tmodule; islibrary : boolean) : boolean;
function proc_program_declarations(curr : tmodule; islibrary : boolean) : boolean;
procedure finish_unit(module:tmodule;immediate:boolean);
procedure finish_unit(module:tmodule);
implementation
@ -1127,7 +1127,7 @@ type
curr.finishstate:=finishstate;
if result then
finish_unit(curr,true)
finish_unit(curr)
else
curr.state:=ms_compiling_waitfinish;
end;
@ -1409,7 +1409,7 @@ type
result:=parse_unit_interface_declarations(curr);
end;
procedure finish_unit(module:tmodule;immediate:boolean);
procedure finish_unit(module:tmodule);
function is_assembler_generated:boolean;
var
@ -1429,8 +1429,6 @@ type
procedure module_is_done(curr: tmodule);inline;
begin
FreeAndNil(curr.globalstate);
dispose(pfinishstate(curr.finishstate));
curr.finishstate:=nil;
end;
@ -1447,22 +1445,8 @@ type
i : longint;
ag : boolean;
finishstate : tfinishstate;
globalstate : tglobalstate;
waitingmodule : tmodule;
begin
globalstate:=default(tglobalstate);
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);
tglobalstate(module.globalstate).restore(true);
end;
{ curr is now module }
if not assigned(module.finishstate) then
@ -1577,7 +1561,9 @@ type
symtablestack.pop(module.globalsymtable);
{ the last char should always be a point }
consume(_POINT);
{ Do not attempt to read next token after dot,
there may be a #0 when the unit was finished in a separate stage }
consume_last_dot;
{ reset wpo flags for all defs }
reset_all_defs(module);
@ -1605,9 +1591,6 @@ type
Message1(unit_f_errors_in_unit,tostr(Errorcount));
status.skip_error:=true;
module_is_done(module);
if not immediate then
restore_global_state(globalstate,true);
{$ifdef DEBUG_NODE_XML}
XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}
@ -1698,9 +1681,6 @@ type
Message1(unit_f_errors_in_unit,tostr(Errorcount));
status.skip_error:=true;
module_is_done(module);
if not immediate then
restore_global_state(globalstate,true);
{$ifdef DEBUG_NODE_XML}
XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}
@ -1750,21 +1730,12 @@ type
module_is_done(module);
module.end_of_parsing;
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;
{$ifdef DEBUG_NODE_XML}
XMLFinalizeNodeFile('unit');
{$endif DEBUG_NODE_XML}