From 2ac4a591c1673e190c131dbfd452bb1550cf9dbf Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 20 Feb 2015 10:43:40 +0100 Subject: [PATCH] [multiple changes] 2015-02-20 Eric Botcazou * s-stalib.ads: Fix typo. 2015-02-20 Ed Schonberg * 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 * lib-load.adb: Minor comment update. 2015-02-20 Vincent Celier * 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 * 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 --- gcc/ada/ChangeLog | 28 +++++++++++++++++++ gcc/ada/exp_ch3.adb | 9 ++++++- gcc/ada/exp_ch6.adb | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/lib-load.adb | 2 +- gcc/ada/prj-proc.adb | 10 ++++--- gcc/ada/s-stalib.ads | 2 +- 6 files changed, 119 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bad2730..2144ec8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2015-02-20 Eric Botcazou + + * s-stalib.ads: Fix typo. + +2015-02-20 Ed Schonberg + + * 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 + + * lib-load.adb: Minor comment update. + +2015-02-20 Vincent Celier + + * 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 + + * 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 * einfo.ads: Minor comment updates Fix missing pragma Inline diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 095e233..3d0ee1f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5356,8 +5356,15 @@ package body Exp_Ch3 is 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; ------------------------- diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 5776370..c9c5da2 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -970,6 +970,10 @@ package body Exp_Ch6 is -- 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; @@ -1750,10 +1754,50 @@ package body Exp_Ch6 is -- 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; @@ -1771,7 +1815,34 @@ package body Exp_Ch6 is 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 @@ -7609,6 +7680,7 @@ package body Exp_Ch6 is if Present (Class_Pre) then Merge_Preconditions (Check_Prag, Class_Pre); + else Class_Pre := Check_Prag; end if; diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index aef313f..83d3576 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -740,7 +740,7 @@ package body Lib.Load is 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 diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 3bad060..57b88c6 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -2363,13 +2363,17 @@ package body Prj.Proc 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 diff --git a/gcc/ada/s-stalib.ads b/gcc/ada/s-stalib.ads index e3e8e10..8d96677 100644 --- a/gcc/ada/s-stalib.ads +++ b/gcc/ada/s-stalib.ads @@ -242,7 +242,7 @@ package System.Standard_Library is -- 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. -- 2.7.4