From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch7.adb | 58 ++++++++++++++++++++++++++++++++++++++++++++
gcc/ada/sem_ch13.adb | 18 +++++++++++---
2 files changed, 72 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 044b14ad305..b545a58448d 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 55b0a7a5ccf..3fb0209f612 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;
------------------------------
--
2.45.2
