mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 17:09:27 +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/tw13318.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw1333.pp svneol=native#text/plain
|
tests/webtbs/tw1333.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw13343.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/tw13345x.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw13456.pp svneol=native#text/plain
|
tests/webtbs/tw13456.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw1348.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/uw1279.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw13015.pp svneol=native#text/plain
|
tests/webtbs/uw13015.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw1331.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/uw13345y.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw13583.pp svneol=native#text/plain
|
tests/webtbs/uw13583.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw2004.inc svneol=native#text/plain
|
tests/webtbs/uw2004.inc svneol=native#text/plain
|
||||||
|
@ -1095,14 +1095,10 @@ implementation
|
|||||||
OldAsmList : TAsmList;
|
OldAsmList : TAsmList;
|
||||||
hp : tnode;
|
hp : tnode;
|
||||||
begin
|
begin
|
||||||
if (tsym(p).typ in [staticvarsym,localvarsym]) and
|
if (tsym(p).typ = localvarsym) and
|
||||||
{ local (procedure or unit) variables only need initialization if
|
{ local (procedure or unit) variables only need initialization if
|
||||||
they are used }
|
they are used }
|
||||||
((tabstractvarsym(p).refs>0) or
|
((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
|
|
||||||
{ managed return symbols must be inited }
|
{ managed return symbols must be inited }
|
||||||
((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
|
((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
|
||||||
) and
|
) 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