ada: Finish up support for relaxed finalization

This adds a variant of the System.Finalization_Primitives unit that supports
only controlled types with relaxed finalization, and adds the description of
its implementation to Exp_Ch7.

gcc/ada/

	* exp_ch7.adb (Relaxed Finalization): New paragraph in head
	comment.
	* sem_ch13.adb (Validate_Finalizable_Aspect): Give an error
	message if strict finalization is required but not supported by
	the runtime.

2 files changed, 72 insertions, 4 deletions

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 044b14a..b545a58 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -337,6 +337,64 @@ package body Exp_Ch7 is
    --  directly by the compiler during the expansion of allocators and calls to
    --  instances of the Unchecked_Deallocation procedure.
 
+   --------------------------
+   -- Relaxed Finalization --
+   --------------------------
+
+   --  This paragraph describes the differences between the implementation of
+   --  finalization as specified by the Ada RM (called "strict" and documented
+   --  in the previous paragraph) and that of finalization as specified by the
+   --  GNAT RM (called "relaxed") for a second category of controlled objects.
+
+   --  For objects (statically) declared in a scope, the default implementation
+   --  documented in the previous paragraph is used for the scope as a whole as
+   --  soon as one controlled object with strict finalization is present in it,
+   --  including one transient controlled object. Otherwise, that is to say, if
+   --  all the controlled objects in the scope have relaxed finalization, then
+   --  no Finalization_Master is built for this scope, and all the objects are
+   --  finalized explicitly in the reverse order of their creation:
+
+   --    declare
+   --       X : Ctrl := Init;
+   --       Y : Ctrl := Init;
+
+   --    begin
+   --       null;
+   --    end;
+
+   --  is expanded into:
+
+   --    declare
+   --       XMN : aliased System.Finalization_Primitives.Master_Node;
+   --       X : Ctrl := Init;
+   --       System.Finalization_Primitives.Attach_To_Node
+   --         (X'address,
+   --          CtrlFD'unrestricted_access,
+   --          XMN'unrestricted_access);
+   --       YMN : aliased System.Finalization_Primitives.Master_Node;
+   --       Y : Ctrl := Init;
+   --       System.Finalization_Primitives.Attach_To_Node
+   --         (Y'address,
+   --          CtrlFD'unrestricted_access,
+   --          YMN'unrestricted_access);
+
+   --       procedure _Finalizer is
+   --       begin
+   --          Abort_Defer;
+   --          System.Finalization_Primitives.Finalize_Object (YMN);
+   --          System.Finalization_Primitives.Finalize_Object (XMN);
+   --          Abort_Undefer;
+   --       end _Finalizer;
+
+   --    begin
+   --       null;
+   --    end;
+   --    at end
+   --       _Finalizer;
+
+   --  Dynamically allocated objects with relaxed finalization need not be
+   --  finalized and, therefore, are not attached to any finalization chain.
+
    type Final_Primitives is
      (Initialize_Case, Adjust_Case, Finalize_Case, Address_Case);
    --  This enumeration type is defined in order to ease sharing code for
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 55b0a7a..3fb0209 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -17907,9 +17907,10 @@ package body Sem_Ch13 is
       --  If Relaxed_Finalization is set, the Finalize and Adjust procedures
       --  are considered as having the No_Raise aspect specified.
 
-      if Has_Relaxed_Finalization (Typ)
-        and then Serious_Errors_Detected = 0
-      then
+      if Serious_Errors_Detected > 0 then
+         null;
+
+      elsif Has_Relaxed_Finalization (Typ) then
          Assoc := First (Component_Associations (Aggr));
          while Present (Assoc) loop
             Nam := First (Choices (Assoc));
@@ -17922,8 +17923,17 @@ package body Sem_Ch13 is
 
             Next (Assoc);
          end loop;
-      end if;
 
+      --  If Relaxed_Finalization is not set, then check that the support for
+      --  strict finalization is available in the runtime library.
+
+      elsif not In_Predefined_Unit (Cunit (Get_Source_Unit (Typ)))
+        and then not RTE_Available (RE_Finalization_Master)
+      then
+         Error_Msg_N
+           ("only Relaxed Finalization is supported in this configuration",
+            ASN);
+      end if;
    end Validate_Finalizable_Aspect;
 
    ------------------------------