From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Eric Botcazou <ebotcazou@adacore.com>
Subject: [COMMITTED 29/30] ada: Add direct workaround for limitations of RTSfind mechanism
Date: Mon, 20 May 2024 09:48:55 +0200 [thread overview]
Message-ID: <20240520074858.222435-29-poulhies@adacore.com> (raw)
In-Reply-To: <20240520074858.222435-1-poulhies@adacore.com>
From: Eric Botcazou <ebotcazou@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 fdacf1cdc01..993c13c7318 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 386a02b9283..712671a427e 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 fe87fba32b6..f9f9f75fc03 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 e56a40884e4..5f402cf5d6e 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 8b2829ffbbf..c9ccc4d9b52 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 82b4e1cf3f5..73e5388affd 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.
--
2.43.2
next prev parent reply other threads:[~2024-05-20 7:49 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-05-20 7:48 [COMMITTED 01/30] ada: Rework and augment documentation on strict aliasing Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 02/30] ada: Small cleanup in System.Finalization_Primitives unit Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 03/30] ada: Implement representation aspect Max_Entry_Queue_Length Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 04/30] ada: Detect only conflict with synomyms of max queue length Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 05/30] ada: One more adjustment coming from aliasing considerations Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 06/30] ada: Reject too-strict alignment specifications Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 07/30] ada: Use System.Address for address computation in System.Pool_Global Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 08/30] ada: Fix for attribute Width on enumeration types with Discard_Name Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 09/30] ada: Fix static 'Img for enumeration type with Discard_Names Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 10/30] ada: Another small cleanup about allocators and aggregates Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 11/30] ada: Fix incorrect free with Task_Info pragma Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 12/30] ada: Resolve ACATS compilation and execution issues with container aggregates Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 13/30] ada: Extend expansion delaying mechanism to conditional expressions Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 14/30] ada: Tweak handling of thread ID on POSIX Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 15/30] ada: Fix style in list of implementation-defined attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 16/30] ada: Use discrete choice list in declaration of universal type attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 17/30] ada: Remove repeated condition in check for implementation attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 18/30] ada: Apply restriction No_Implementation_Attributes to source nodes only Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 19/30] ada: Fix list of attributes defined by Ada 2012 Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 20/30] ada: Fix list of implementation-defined attributes Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 21/30] ada: Further refine 'Super attribute Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 22/30] ada: Handle accessibility calculations for 'First and 'Last Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 23/30] ada: Error on instantiation of generic containing legal container aggregate Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 24/30] " Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 25/30] ada: Add Is_Base_Type predicate to C interface Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 26/30] ada: Formal package comment corrections in sinfo.ads Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 27/30] ada: Get rid of secondary stack for indefinite record types with size clause Marc Poulhiès
2024-05-20 7:48 ` [COMMITTED 28/30] ada: Fix internal error on nested aggregate in conditional expression Marc Poulhiès
2024-05-20 7:48 ` Marc Poulhiès [this message]
2024-05-20 7:48 ` [COMMITTED 30/30] ada: Allow 'others' in formal packages with overloaded formals Marc Poulhiès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20240520074858.222435-29-poulhies@adacore.com \
--to=poulhies@adacore.com \
--cc=ebotcazou@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).