https://gcc.gnu.org/g:49eb34ea61c6e8fbb10d3a36484cbf5468580fba
commit r15-688-g49eb34ea61c6e8fbb10d3a36484cbf5468580fba
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Sat Mar 30 23:12:51 2024 +0100
ada: Add direct workaround for limitations of RTSfind mechanism
This adds a direct workaround for the spurious compilation errors caused by
the presence of preconditions/postconditions in the Interfaces.C unit, which
trip on limitations of the RTSfind mechanism when it comes to visibility, as
well as removes an indirect workaround that was added very recently.
These errors were first triggered in the context of finalization and worked
around by preloading the System.Finalization_Primitives unit. Now they also
appear in the context of tasking, and it turns out that the preloading trick
does not work for separate compilation units.
gcc/ada/
* exp_ch7.ads (Preload_Finalization_Collection): Delete.
* exp_ch7.adb (Allows_Finalization_Collection): Revert change.
(Preload_Finalization_Collection): Delete.
* opt.ads (Interface_Seen): Likewise.
* scng.adb (Scan): Revert latest change.
* sem_ch10.adb: Remove clause for Exp_Ch7.
(Analyze_Compilation_Unit): Revert latest change.
* libgnat/i-c.ads: Use a fully qualified name for the standard "+"
operator in the preconditons/postconditions of subprograms.
Diff:
---
gcc/ada/exp_ch7.adb | 38 --------------------------------------
gcc/ada/exp_ch7.ads | 6 ------
gcc/ada/libgnat/i-c.ads | 19 +++++++++++--------
gcc/ada/opt.ads | 4 ----
gcc/ada/scng.adb | 5 +----
gcc/ada/sem_ch10.adb | 3 ---
6 files changed, 12 insertions(+), 63 deletions(-)
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index fdacf1cdc012..993c13c73187 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -965,12 +965,6 @@ package body Exp_Ch7 is
if Restriction_Active (No_Finalization) then
return False;
- -- The System.Finalization_Primitives unit must have been preloaded if
- -- finalization is really required.
-
- elsif not RTU_Loaded (System_Finalization_Primitives) then
- return False;
-
-- Do not consider C and C++ types since it is assumed that the non-Ada
-- side will handle their cleanup.
@@ -8630,38 +8624,6 @@ package body Exp_Ch7 is
return Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped;
end Node_To_Be_Wrapped;
- --------------------------------------
- -- Preload_Finalization_Collection --
- --------------------------------------
-
- procedure Preload_Finalization_Collection (Compilation_Unit : Node_Id) is
- begin
- -- We can't call RTE (Finalization_Collection) for at least some
- -- predefined units, because it would introduce cyclic dependences,
- -- as the type is itself a controlled type.
- --
- -- It's only needed when finalization is involved in the unit, which
- -- requires the presence of controlled or class-wide types in the unit
- -- (see the Sem_Util.Needs_Finalization predicate for the rationale).
- -- But controlled types are tagged or contain tagged (sub)components
- -- so it is sufficient for the parser to detect the "interface" and
- -- "tagged" keywords.
- --
- -- Don't do it if Finalization_Collection is unavailable in the runtime
-
- if not In_Predefined_Unit (Compilation_Unit)
- and then (Interface_Seen or else Tagged_Seen)
- and then not No_Run_Time_Mode
- and then RTE_Available (RE_Finalization_Collection)
- then
- declare
- Ignore : constant Entity_Id := RTE (RE_Finalization_Collection);
- begin
- null;
- end;
- end if;
- end Preload_Finalization_Collection;
-
----------------------------
-- Store_Actions_In_Scope --
----------------------------
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index 386a02b9283a..712671a427e0 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -257,12 +257,6 @@ package Exp_Ch7 is
-- Build a call to suppress the finalization of the object Obj, only after
-- creating the Master_Node of Obj if it does not already exist.
- procedure Preload_Finalization_Collection (Compilation_Unit : Node_Id);
- -- Call RTE (RE_Finalization_Collection) if necessary to load the packages
- -- involved in finalization support. We need to do this explicitly, fairly
- -- early during compilation, because otherwise it happens during freezing,
- -- which triggers visibility bugs in generic instantiations.
-
--------------------------------------------
-- Task and Protected Object finalization --
--------------------------------------------
diff --git a/gcc/ada/libgnat/i-c.ads b/gcc/ada/libgnat/i-c.ads
index fe87fba32b60..f9f9f75fc037 100644
--- a/gcc/ada/libgnat/i-c.ads
+++ b/gcc/ada/libgnat/i-c.ads
@@ -24,6 +24,9 @@ pragma Assertion_Policy (Pre => Ignore,
Contract_Cases => Ignore,
Ghost => Ignore);
+-- Pre/postconditions use a fully qualified name for the standard "+" operator
+-- in order to work around an internal limitation of the compiler.
+
with System;
with System.Parameters;
@@ -146,7 +149,7 @@ is
Pre => not (Append_Nul = False and then Item'Length = 0),
Post => To_C'Result'First = 0
and then To_C'Result'Length =
- (if Append_Nul then Item'Length + 1 else Item'Length)
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length)
and then (for all J in Item'Range =>
To_C'Result (size_t (J - Item'First)) = To_C (Item (J)))
and then (if Append_Nul then To_C'Result (To_C'Result'Last) = nul);
@@ -190,7 +193,7 @@ is
with
Relaxed_Initialization => Target,
Pre => Target'Length >=
- (if Append_Nul then Item'Length + 1 else Item'Length),
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length),
Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length)
and then
(if Count /= 0 then
@@ -287,7 +290,7 @@ is
Pre => not (Append_Nul = False and then Item'Length = 0),
Post => To_C'Result'First = 0
and then To_C'Result'Length =
- (if Append_Nul then Item'Length + 1 else Item'Length)
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length)
and then (for all J in Item'Range =>
To_C'Result (size_t (J - Item'First)) = To_C (Item (J)))
and then (if Append_Nul then To_C'Result (To_C'Result'Last) = wide_nul);
@@ -316,7 +319,7 @@ is
with
Relaxed_Initialization => Target,
Pre => Target'Length >=
- (if Append_Nul then Item'Length + 1 else Item'Length),
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length),
Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length)
and then
(if Count /= 0 then
@@ -408,7 +411,7 @@ is
Pre => not (Append_Nul = False and then Item'Length = 0),
Post => To_C'Result'First = 0
and then To_C'Result'Length =
- (if Append_Nul then Item'Length + 1 else Item'Length)
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length)
and then (for all J in Item'Range =>
To_C'Result (size_t (J - Item'First)) = To_C (Item (J)))
and then
@@ -440,7 +443,7 @@ is
with
Relaxed_Initialization => Target,
Pre => Target'Length >=
- (if Append_Nul then Item'Length + 1 else Item'Length),
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length),
Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length)
and then
(if Count /= 0 then
@@ -528,7 +531,7 @@ is
Pre => not (Append_Nul = False and then Item'Length = 0),
Post => To_C'Result'First = 0
and then To_C'Result'Length =
- (if Append_Nul then Item'Length + 1 else Item'Length)
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length)
and then (for all J in Item'Range =>
To_C'Result (size_t (J - Item'First)) = To_C (Item (J)))
and then
@@ -560,7 +563,7 @@ is
with
Relaxed_Initialization => Target,
Pre => Target'Length >=
- (if Append_Nul then Item'Length + 1 else Item'Length),
+ (if Append_Nul then Standard."+" (Item'Length, 1) else Item'Length),
Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length)
and then
(if Count /= 0 then
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index e56a40884e46..5f402cf5d6e9 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1919,10 +1919,6 @@ package Opt is
-- be in the spec of Expander, but it is referenced by Errout, and it
-- really seems wrong for Errout to depend on Expander.
- Interface_Seen : Boolean := False;
- -- Set True by the parser if the "interface" reserved word is seen. This is
- -- needed in Exp_Ch7 (see that package for documentation).
-
Tagged_Seen : Boolean := False;
-- Set True by the parser if the "tagged" reserved word is seen. This is
-- needed in Exp_Put_Image (see that package for documentation).
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 8b2829ffbbfc..c9ccc4d9b52f 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -2786,12 +2786,9 @@ package body Scng is
Accumulate_Token_Checksum;
Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
- if Token = Tok_Interface then
- Interface_Seen := True;
-
-- See Exp_Put_Image for documentation of Tagged_Seen
- elsif Token = Tok_Tagged then
+ if Token = Tok_Tagged then
Tagged_Seen := True;
end if;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 82b4e1cf3f5f..73e5388affdc 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -31,7 +31,6 @@ with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Errout; use Errout;
-with Exp_Ch7;
with Exp_Disp; use Exp_Disp;
with Exp_Put_Image;
with Exp_Util; use Exp_Util;
@@ -926,8 +925,6 @@ package body Sem_Ch10 is
Set_Context_Pending (N, False);
- Exp_Ch7.Preload_Finalization_Collection (N);
-
-- If the unit is a package body, the spec is already loaded and must be
-- analyzed first, before we analyze the body.
