From 49eb34ea61c6e8fbb10d3a36484cbf5468580fba Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 30 Mar 2024 23:12:51 +0100 Subject: [PATCH] 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. --- 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.