Browse Source

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

Jonas Maebe 16 years ago
parent
commit
e2b8792bd3
5 changed files with 50 additions and 8 deletions
  1. 3 0
      .gitattributes
  2. 4 8
      compiler/ncgutil.pas
  3. 13 0
      tests/webtbs/tw13345.pp
  4. 18 0
      tests/webtbs/uw13345b.pp
  5. 12 0
      tests/webtbs/uw13345c.pp

+ 3 - 0
.gitattributes

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

+ 4 - 8
compiler/ncgutil.pas

@@ -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 - 0
tests/webtbs/tw13345.pp

@@ -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 - 0
tests/webtbs/uw13345b.pp

@@ -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 - 0
tests/webtbs/uw13345c.pp

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