Patchwork [Ada] Fix discrepancy between initialization and finalization of libraries

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 4, 2011, 12:02 p.m.
Message ID <20110804120214.GA25765@adacore.com>
Download mbox | patch
Permalink /patch/108420/
State New
Headers show

Comments

Arnaud Charlet - Aug. 4, 2011, 12:02 p.m.
This adjusts the finalization code emitted in the binder-generated file so as
to make it symmetrical to the initialization code with regard to the handling
of the elaboration counter.  Both now increment or decrement the counter only
once per library unit, even though the elaboration or finalization of the spec
and the body requires two calls.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>

	* bindgen.adb (Gen_Finalize_Library_Ada): Factor out code to generate
	the header of the finalization routine.
	If the unit has no finalizer but is a body whose spec has one, then
	generate the decrement of the elaboration entity only.
	If the unit has a finalizer and is a spec, then do not generate the
	decrement of the elaboration entity.
	(Gen_Finalize_Library_C): Likewise.

Patch

Index: bindgen.adb
===================================================================
--- bindgen.adb	(revision 177360)
+++ bindgen.adb	(working copy)
@@ -1662,40 +1662,86 @@ 
       Uspec : Unit_Record;
       Unum  : Unit_Id;
 
+      procedure Gen_Header;
+      --  Generate the header of the finalization routine
+
+      procedure Gen_Header is
+      begin
+         WBI ("   procedure finalize_library is");
+
+         --  The following flag is used to check for library-level
+         --  exceptions raised during finalization. The symbol comes
+         --  from System.Soft_Links. VM targets use regular Ada to
+         --  reference the entity.
+
+         if VM_Target = No_VM then
+            WBI ("      LE_Set : Boolean;");
+
+            Set_String ("      pragma Import (Ada, LE_Set, ");
+            Set_String ("""__gnat_library_exception_set"");");
+            Write_Statement_Buffer;
+         end if;
+
+         WBI ("   begin");
+      end Gen_Header;
+
    begin
       for E in reverse Elab_Order.First .. Elab_Order.Last loop
          Unum := Elab_Order.Table (E);
          U    := Units.Table (Unum);
 
+         --  Dealing with package bodies is a little complicated. In such
+         --  cases we must retrieve the package spec since it contains the
+         --  spec of the body finalizer.
+
+         if U.Utype = Is_Body then
+            Unum  := Unum + 1;
+            Uspec := Units.Table (Unum);
+         else
+            Uspec := U;
+         end if;
+
+         Get_Name_String (Uspec.Uname);
+
          --  We are only interested in non-generic packages
 
-         if U.Unit_Kind = 'p'
-           and then U.Has_Finalizer
-           and then not U.Is_Generic
-           and then not U.SAL_Interface
-           and then not U.No_Elab
-         then
-            if not Lib_Final_Built then
-               Lib_Final_Built := True;
+         if U.Unit_Kind /= 'p' or else U.Is_Generic then
+            null;
 
-               WBI ("   procedure finalize_library is");
+         --  That aren't an interface to a stand alone library
 
-               --  The following flag is used to check for library-level
-               --  exceptions raised during finalization. The symbol comes
-               --  from System.Soft_Links. VM targets use regular Ada to
-               --  reference the entity.
+         elsif U.SAL_Interface then
+            null;
 
-               if VM_Target = No_VM then
-                  WBI ("      LE_Set : Boolean;");
+         --  Case of no finalization
 
-                  Set_String ("      pragma Import (Ada, LE_Set, ");
-                  Set_String ("""__gnat_library_exception_set"");");
-                  Write_Statement_Buffer;
+         elsif not U.Has_Finalizer then
+
+            --  The only case in which we have to do something is if this
+            --  is a body, with a separate spec, where the separate spec
+            --  has a finalizer. In that case, this is where we decrement
+            --  the elaboration entity.
+
+            if U.Utype = Is_Body and then Uspec.Has_Finalizer then
+               if not Lib_Final_Built then
+                  Gen_Header;
+                  Lib_Final_Built := True;
                end if;
 
-               WBI ("   begin");
+               Set_String ("      E");
+               Set_Unit_Number (Unum);
+               Set_String (" := E");
+               Set_Unit_Number (Unum);
+               Set_String (" - 1;");
+               Write_Statement_Buffer;
             end if;
 
+         else
+            if not Lib_Final_Built then
+               Gen_Header;
+               Lib_Final_Built := True;
+            end if;
+
             --  Generate:
             --    declare
             --       procedure F<Count>;
@@ -1732,19 +1778,6 @@ 
             Set_Int (Count);
             Set_String (", """);
 
-            --  Dealing with package bodies is a little complicated. In such
-            --  cases we must retrieve the package spec since it contains the
-            --  spec of the body finalizer.
-
-            if U.Utype = Is_Body then
-               Unum  := Unum + 1;
-               Uspec := Units.Table (Unum);
-            else
-               Uspec := U;
-            end if;
-
-            Get_Name_String (Uspec.Uname);
-
             --  Perform name construction
 
             --  .NET   xx.yy_pkg.xx__yy__finalize
@@ -1798,14 +1831,20 @@ 
             --       F<Count>;
             --    end;
 
+            --  The uname_E decrement is skipped if this is a separate spec,
+            --  since it will be done when we process the body.
+
             WBI ("      begin");
-            Set_String ("         E");
-            Set_Unit_Number (Unum);
-            Set_String (" := E");
-            Set_Unit_Number (Unum);
-            Set_String (" - 1;");
-            Write_Statement_Buffer;
 
+            if U.Utype /= Is_Spec then
+               Set_String ("         E");
+               Set_Unit_Number (Unum);
+               Set_String (" := E");
+               Set_Unit_Number (Unum);
+               Set_String (" - 1;");
+               Write_Statement_Buffer;
+            end if;
+
             if Interface_Library_Unit or not Bind_Main_Program then
                Set_String ("         if E");
                Set_Unit_Number (Unum);
@@ -1884,37 +1923,68 @@ 
       Uspec : Unit_Record;
       Unum  : Unit_Id;
 
+      procedure Gen_Header;
+      --  Generate the header of the finalization routine
+
+      procedure Gen_Header is
+      begin
+         WBI ("static void finalize_library(void) {");
+      end Gen_Header;
+
    begin
       for E in reverse Elab_Order.First .. Elab_Order.Last loop
          Unum := Elab_Order.Table (E);
          U    := Units.Table (Unum);
 
+         --  Dealing with package bodies is a little complicated. In such
+         --  cases we must retrieve the package spec since it contains the
+         --  spec of the body finalizer.
+
+         if U.Utype = Is_Body then
+            Unum  := Unum + 1;
+            Uspec := Units.Table (Unum);
+         else
+            Uspec := U;
+         end if;
+
+         Get_Name_String (Uspec.Uname);
+
          --  We are only interested in non-generic packages
 
-         if U.Unit_Kind = 'p'
-           and then U.Has_Finalizer
-           and then not U.Is_Generic
-           and then not U.SAL_Interface
-           and then not U.No_Elab
-         then
-            if not Lib_Final_Built then
-               Lib_Final_Built := True;
+         if U.Unit_Kind /= 'p' or else U.Is_Generic then
+            null;
 
-               WBI ("static void finalize_library(void) {");
-            end if;
+         --  That aren't an interface to a stand alone library
 
-            --  Dealing with package bodies is a little complicated. In such
-            --  cases we must retrieve the package spec since it contains the
-            --  spec of the body finalizer.
+         elsif U.SAL_Interface then
+            null;
 
-            if U.Utype = Is_Body then
-               Unum  := Unum + 1;
-               Uspec := Units.Table (Unum);
-            else
-               Uspec := U;
+         --  Case of no finalization
+
+         elsif not U.Has_Finalizer then
+
+            --  The only case in which we have to do something is if this
+            --  is a body, with a separate spec, where the separate spec
+            --  has a finalizer. In that case, this is where we decrement
+            --  the elaboration entity.
+
+            if U.Utype = Is_Body and then Uspec.Has_Finalizer then
+               if not Lib_Final_Built then
+                  Gen_Header;
+                  Lib_Final_Built := True;
+               end if;
+
+               Set_String ("   ");
+               Set_Unit_Name;
+               Set_String ("_E--;");
+               Write_Statement_Buffer;
             end if;
 
-            Get_Name_String (Uspec.Uname);
+         else
+            if not Lib_Final_Built then
+               Gen_Header;
+               Lib_Final_Built := True;
+            end if;
 
             --  If binding a library or if there is a non-Ada main subprogram
             --  then we generate:
@@ -1928,11 +1998,16 @@ 
             --    uname_E--;
             --    uname__finalize_[spec|body] ();
 
-            Set_String ("   ");
-            Set_Unit_Name;
-            Set_String ("_E--;");
-            Write_Statement_Buffer;
+            --  The uname_E decrement is skipped if this is a separate spec,
+            --  since it will be done when we process the body.
 
+            if U.Utype /= Is_Spec then
+               Set_String ("   ");
+               Set_Unit_Name;
+               Set_String ("_E--;");
+               Write_Statement_Buffer;
+            end if;
+
             if Interface_Library_Unit or not Bind_Main_Program then
                Set_String ("   if (");
                Set_Unit_Name;