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.
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 --
----------------------------
-- 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 --
--------------------------------------------
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;
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);
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
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);
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
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
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
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
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
-- 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).
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;
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;
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.
projects / thirdparty / gcc.git / commitdiff
