mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 22:49:37 +02:00
* do not initialize global reference-counted variables in the automatic
initialization code of units/programs, because they are already zero and initializing them explicitly is Delphi-incompatible (mantis #13345) git-svn-id: trunk@13042 -
This commit is contained in:
parent
90b2d673df
commit
e2b8792bd3
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -8821,6 +8821,7 @@ tests/webtbs/tw13313a.pp svneol=native#text/plain
|
||||
tests/webtbs/tw13318.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1333.pp svneol=native#text/plain
|
||||
tests/webtbs/tw13343.pp svneol=native#text/plain
|
||||
tests/webtbs/tw13345.pp svneol=native#text/plain
|
||||
tests/webtbs/tw13345x.pp svneol=native#text/plain
|
||||
tests/webtbs/tw13456.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1348.pp svneol=native#text/plain
|
||||
@ -9719,6 +9720,8 @@ tests/webtbs/uw1181.inc svneol=native#text/plain
|
||||
tests/webtbs/uw1279.pp svneol=native#text/plain
|
||||
tests/webtbs/uw13015.pp svneol=native#text/plain
|
||||
tests/webtbs/uw1331.pp svneol=native#text/plain
|
||||
tests/webtbs/uw13345b.pp svneol=native#text/plain
|
||||
tests/webtbs/uw13345c.pp svneol=native#text/plain
|
||||
tests/webtbs/uw13345y.pp svneol=native#text/plain
|
||||
tests/webtbs/uw13583.pp svneol=native#text/plain
|
||||
tests/webtbs/uw2004.inc svneol=native#text/plain
|
||||
|
@ -1095,14 +1095,10 @@ implementation
|
||||
OldAsmList : TAsmList;
|
||||
hp : tnode;
|
||||
begin
|
||||
if (tsym(p).typ in [staticvarsym,localvarsym]) and
|
||||
{ local (procedure or unit) variables only need initialization if
|
||||
they are used }
|
||||
((tabstractvarsym(p).refs>0) or
|
||||
{ global (unit) variables always need initialization, since
|
||||
they may also be used in another unit
|
||||
}
|
||||
(tabstractvarsym(p).owner.symtabletype=globalsymtable) or
|
||||
if (tsym(p).typ = localvarsym) and
|
||||
{ local (procedure or unit) variables only need initialization if
|
||||
they are used }
|
||||
((tabstractvarsym(p).refs>0) or
|
||||
{ managed return symbols must be inited }
|
||||
((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
|
||||
) and
|
||||
|
13
tests/webtbs/tw13345.pp
Normal file
13
tests/webtbs/tw13345.pp
Normal file
@ -0,0 +1,13 @@
|
||||
{ %opt=-gh }
|
||||
|
||||
program iftest;
|
||||
{$mode DELPHI}
|
||||
uses uw13345c;
|
||||
//uses uw13345b, uw13345c;
|
||||
begin
|
||||
HaltOnNotReleased:=true;
|
||||
Writeln('START');
|
||||
GTEST.Test;
|
||||
Writeln('END');
|
||||
end.
|
||||
|
18
tests/webtbs/uw13345b.pp
Normal file
18
tests/webtbs/uw13345b.pp
Normal file
@ -0,0 +1,18 @@
|
||||
unit uw13345b;
|
||||
{$mode DELPHI}
|
||||
interface
|
||||
uses uw13345c;
|
||||
implementation
|
||||
type
|
||||
TTestIntf=class(TInterfacedObject,ITestIF)
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
procedure TTestIntf.Test;
|
||||
begin
|
||||
writeln('OK');
|
||||
end;
|
||||
initialization
|
||||
GTEST:=TTestIntf.Create;
|
||||
writeln('ASSIGNED IF');
|
||||
end.
|
12
tests/webtbs/uw13345c.pp
Normal file
12
tests/webtbs/uw13345c.pp
Normal file
@ -0,0 +1,12 @@
|
||||
unit uw13345c;
|
||||
{$mode DELPHI}
|
||||
interface
|
||||
type ITestIF=interface
|
||||
procedure Test;
|
||||
end;
|
||||
var GTEST:ITestIF;
|
||||
implementation
|
||||
uses uw13345b;
|
||||
initialization
|
||||
writeln('initc start');
|
||||
end.
|
Loading…
Reference in New Issue
Block a user