2015-02-20 Eric Botcazou <ebotcazou@adacore.com>
* s-stalib.ads: Fix typo.
2015-02-20 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Default_Initialize_Object): If the object has a
delayed freeze, the actions associated with default initialization
must be part of the freeze actions, rather that being inserted
directly after the object declaration.
2015-02-20 Robert Dewar <dewar@adacore.com>
* lib-load.adb: Minor comment update.
2015-02-20 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Process_Case_Construction): When there are
incomplete withed projects and the case variable is unknown,
skip the case construction.
2015-02-20 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Actuals): Add caller-side invariant checks
when an actual is a view conversion, either because the call is
to an inherited operation, or because the actual is an explicit
type conversion to an ancestor type. Fixes ACATS 4.0D:
C732001
From-SVN: r220840
+2015-02-20 Eric Botcazou <ebotcazou@adacore.com>
+
+ * s-stalib.ads: Fix typo.
+
+2015-02-20 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch3.adb (Default_Initialize_Object): If the object has a
+ delayed freeze, the actions associated with default initialization
+ must be part of the freeze actions, rather that being inserted
+ directly after the object declaration.
+
+2015-02-20 Robert Dewar <dewar@adacore.com>
+
+ * lib-load.adb: Minor comment update.
+
+2015-02-20 Vincent Celier <celier@adacore.com>
+
+ * prj-proc.adb (Process_Case_Construction): When there are
+ incomplete withed projects and the case variable is unknown,
+ skip the case construction.
+
+2015-02-20 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Expand_Actuals): Add caller-side invariant checks
+ when an actual is a view conversion, either because the call is
+ to an inherited operation, or because the actual is an explicit
+ type conversion to an ancestor type. Fixes ACATS 4.0D: C732001
+
2015-02-20 Robert Dewar <dewar@adacore.com>
* einfo.ads: Minor comment updates Fix missing pragma Inline
end if;
-- Step 4: Insert the whole initialization sequence into the tree
+ -- If the object has a delayed freeze, as will be the case when
+ -- it has aspect specifications, the initialization sequence is
+ -- part of the freeze actions.
- Insert_Actions_After (After, Abrt_Stmts);
+ if Has_Delayed_Freeze (Def_Id) then
+ Append_Freeze_Actions (Def_Id, Abrt_Stmts);
+ else
+ Insert_Actions_After (After, Abrt_Stmts);
+ end if;
end Default_Initialize_Object;
-------------------------
-- Expand_Actuals --
--------------------
+ --------------------
+ -- Expand_Actuals --
+ --------------------
+
procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
Actual : Node_Id;
-- be handled separately because the name does not denote an
-- overloadable entity.
- declare
+ By_Ref_Predicate_Check : declare
Aund : constant Entity_Id := Underlying_Type (E_Actual);
Atyp : Entity_Id;
+ function Is_Public_Subp return Boolean;
+ -- Check whether the subprogram being called is a visible
+ -- operation of the type of the actual. Used to determine
+ -- whether an invariant check must be generated on the
+ -- caller side.
+
+ ---------------------
+ -- Is_Public_Subp --
+ ---------------------
+
+ function Is_Public_Subp return Boolean is
+ Pack : constant Entity_Id := Scope (Subp);
+ Subp_Decl : Node_Id;
+
+ begin
+ if not Is_Subprogram (Subp) then
+ return False;
+
+ -- The operation may be inherited, or a primitive of the
+ -- root type.
+
+ elsif
+ Nkind_In (Parent (Subp), N_Private_Extension_Declaration,
+ N_Full_Type_Declaration)
+ then
+ Subp_Decl := Parent (Subp);
+
+ else
+ Subp_Decl := Unit_Declaration_Node (Subp);
+ end if;
+
+ return Ekind (Pack) = E_Package
+ and then
+ List_Containing (Subp_Decl) =
+ Visible_Declarations
+ (Specification (Unit_Declaration_Node (Pack)));
+ end Is_Public_Subp;
+
+ -- Start of processing for By_Ref_Predicate_Check
+
begin
if No (Aund) then
Atyp := E_Actual;
Append_To (Post_Call,
Make_Predicate_Check (Atyp, Actual));
end if;
- end;
+
+ -- We generated caller-side invariant checks in two cases:
+
+ -- a) when calling an inherited operation, where there is an
+ -- implicit view conversion of the actual to the parent type.
+
+ -- b) When the conversion is explicit
+
+ -- We treat these cases separately because the required
+ -- conversion for a) is added later when expanding the call.
+
+ if Has_Invariants (Etype (Actual))
+ and then
+ Nkind (Parent (Subp)) = N_Private_Extension_Declaration
+ then
+ if Comes_From_Source (N) and then Is_Public_Subp then
+ Append_To (Post_Call, Make_Invariant_Call (Actual));
+ end if;
+
+ elsif Nkind (Actual) = N_Type_Conversion
+ and then Has_Invariants (Etype (Expression (Actual)))
+ then
+ if Comes_From_Source (N) and then Is_Public_Subp then
+ Append_To (Post_Call,
+ Make_Invariant_Call (Expression (Actual)));
+ end if;
+ end if;
+ end By_Ref_Predicate_Check;
-- Processing for IN parameters
if Present (Class_Pre) then
Merge_Preconditions (Check_Prag, Class_Pre);
+
else
Class_Pre := Check_Prag;
end if;
goto Done;
end if;
- -- If loaded unit had a fatal error, then caller inherits setting
+ -- If loaded unit had an error, then caller inherits setting
if Present (Error_Node) then
case Units.Table (Unum).Fatal_Error is
end if;
if Var_Id = No_Variable then
+ if Node_Tree.Incomplete_With then
+ return;
-- Should never happen, because this has already been checked
-- during parsing.
- Write_Line
- ("variable """ & Get_Name_String (Name) & """ not found");
- raise Program_Error;
+ else
+ Write_Line
+ ("variable """ & Get_Name_String (Name) & """ not found");
+ raise Program_Error;
+ end if;
end if;
-- Get the case variable
-- A little procedure that just calls Abort_Undefer.all, for use in
-- clean up procedures, which only permit a simple subprogram name.
-- ??? This procedure is not marked inline because the front-end
- -- cannot currently mark its calls from at-end handers as inlined.
+ -- cannot currently mark its calls from at-end handlers as inlined.
procedure Adafinal;
-- Performs the Ada Runtime finalization the first time it is invoked.