diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-03-30 23:12:51 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-20 09:47:06 +0200 |
commit | 49eb34ea61c6e8fbb10d3a36484cbf5468580fba (patch) | |
tree | 117525431d5610ceb9de71d055bbe4cc834c2c91 /gcc | |
parent | bfa743ddc9fd1850a7cc282afe5f3101b544ac64 (diff) | |
download | gcc-49eb34ea61c6e8fbb10d3a36484cbf5468580fba.zip gcc-49eb34ea61c6e8fbb10d3a36484cbf5468580fba.tar.gz gcc-49eb34ea61c6e8fbb10d3a36484cbf5468580fba.tar.bz2 |
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_ch7.adb | 38 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.ads | 6 | ||||
-rw-r--r-- | gcc/ada/libgnat/i-c.ads | 19 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 4 | ||||
-rw-r--r-- | gcc/ada/scng.adb | 5 | ||||
-rw-r--r-- | 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 fdacf1c..993c13c 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 386a02b..712671a 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 fe87fba..f9f9f75 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 e56a408..5f402cf 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 8b2829f..c9ccc4d 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 82b4e1c..73e5388 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. |