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.
This commit is contained in:
Eric Botcazou
Marc Poulhiès
parent
bfa743ddc9
commit
49eb34ea61
6 changed files with 12 additions and 63 deletions
|
|
@ -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 --
|
||||
----------------------------
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
--------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue