paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-09 12:11:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix compiler compilation with -dHEAPTRC.

Browse Source 
This was brkoken because the -dHEAPTRC option
  adds ppheap unit at top of the uses clause in pp.pas source,
  which leads to a change in the loading order of the units.
  This order change revealed that initialization of fpkg unit
  was supposed to happen after globals unit.

  Fixed here by testing if initdoneprocs local variable is assigned,
  both in register_initdone_proc and in allocinitdoneprocs,
  to avoid double initialization.

git-svn-id: trunk@34361 -
This commit is contained in:
pierre 2016-08-21 22:21:09 +00:00
parent ea4350d86a
commit 8d1467157c
1 changed files with 26 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/globals.pas
View File

@ -1388,8 +1388,17 @@ implementation
pinitdoneentry=^tinitdoneentry;
var
initdoneprocs : TFPList;
const
initdoneprocs : TFPList = nil;
procedure allocinitdoneprocs;
begin
{ Avoid double initialization }
if assigned(initdoneprocs) then
exit;
initdoneprocs:=tfplist.create;
end;
procedure register_initdone_proc(init,done:tprocedure);
@ -1399,6 +1408,13 @@ implementation
new(entry);
entry^.init:=init;
entry^.done:=done;
{ Do not rely on the fact that
globals unit initialization code
has already been executed.
Unit initialization order is too
uncertian for that. PM }
if not assigned(initdoneprocs) then
allocinitdoneprocs;
initdoneprocs.add(entry);
end;
@ -1407,6 +1423,8 @@ implementation
var
i : longint;
begin
if not assigned(initdoneprocs) then
exit;
for i:=0 to initdoneprocs.count-1 do
with pinitdoneentry(initdoneprocs[i])^ do
if assigned(init) then
@ -1418,6 +1436,8 @@ implementation
var
i : longint;
begin
if not assigned(initdoneprocs) then
exit;
for i:=0 to initdoneprocs.count-1 do
with pinitdoneentry(initdoneprocs[i])^ do
if assigned(done) then
@ -1425,19 +1445,17 @@ implementation
end;
procedure allocinitdoneprocs;
begin
initdoneprocs:=tfplist.create;
end;
procedure freeinitdoneprocs;
var
i : longint;
begin
if not assigned(initdoneprocs) then
exit;
for i:=0 to initdoneprocs.count-1 do
dispose(pinitdoneentry(initdoneprocs[i]));
initdoneprocs.free;
{ Reset variable, to be on the safe side }
initdoneprocs:=nil;
end;