Browse Source

* Partially reverted r19668. It turns out that the implicit finally block in constructors, besides its intended purpose, provides correct position of the exit label (more precisely, it relocates exit label to the start of 'finally' part without subsequent restoring it to original value). Optimizing it away causes exit statements in constructors to jump over AfterConstruction call.
+ Test to prevent it from happening again.

git-svn-id: trunk@19948 -

sergei 13 years ago
parent
commit
66ec137f09
3 changed files with 31 additions and 7 deletions
  1. 1 0
      .gitattributes
  2. 2 7
      compiler/psub.pas
  3. 28 0
      tests/test/cg/tctr1.pp

+ 1 - 0
.gitattributes

@@ -9541,6 +9541,7 @@ tests/test/cg/tcnvstr2.pp svneol=native#text/plain
 tests/test/cg/tcnvstr3.pp svneol=native#text/plain
 tests/test/cg/tcppcl1.pp svneol=native#text/plain
 tests/test/cg/tcppcl2.pp svneol=native#text/plain
+tests/test/cg/tctr1.pp svneol=native#text/plain
 tests/test/cg/tderef.pp svneol=native#text/plain
 tests/test/cg/tdivz1.pp svneol=native#text/plain
 tests/test/cg/tdivz2.pp svneol=native#text/plain

+ 2 - 7
compiler/psub.pas

@@ -284,6 +284,7 @@ implementation
               begin
                 if is_class(current_structdef) then
                   begin
+                    include(current_procinfo.flags,pi_needs_implicit_finally);
                     srsym:=search_struct_member(current_structdef,'NEWINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
@@ -698,13 +699,7 @@ implementation
           end
         else
           begin
-            { Constructors need the destroy-on-exception code even if they don't
-              use managed variables/temps. }
-            if (cs_implicit_exceptions in current_settings.moduleswitches) and
-               (is_class(procdef.struct) and (procdef.proctypeoption=potype_constructor)) then
-              maybe_add_constructor_wrapper(code,true)
-            else
-              maybe_add_constructor_wrapper(code,false);
+            maybe_add_constructor_wrapper(code,false);
             addstatement(newstatement,loadpara_asmnode);
             addstatement(newstatement,stackcheck_asmnode);
             addstatement(newstatement,entry_asmnode);

+ 28 - 0
tests/test/cg/tctr1.pp

@@ -0,0 +1,28 @@
+{$mode objfpc}{$h+}
+
+type
+  tobj=class(TObject)
+    ffield:boolean;
+    constructor Create;
+    procedure AfterConstruction;override;
+  end;
+
+{ Exit statement in constructor must not jump over AfterConstruction! }
+constructor tobj.Create;
+begin
+  exit;
+end;
+ 
+procedure tobj.AfterConstruction;
+begin
+  ffield:=true;
+end;
+ 
+ 
+var
+  o: tobj;
+begin
+  o:=tobj.create;
+  if not o.ffield then
+    Halt(1);
+end.