diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 41 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 56 | ||||
| -rw-r--r-- | gcc/ada/sem_dim.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 104 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 |
8 files changed, 162 insertions, 98 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8afa4db..1cff347 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,46 @@ 2014-01-22 Robert Dewar <dewar@adacore.com> + * sem_prag.adb (Analyze_Initializes_In_Decl_Part): Handle null + initializes case. + +2014-01-22 Robert Dewar <dewar@adacore.com> + + * snames.ads-tmpl: Update header. + +2014-01-22 Thomas Quinot <quinot@adacore.com> + + * exp_util.adb (Insert_Actions): When inserting actions on a + short circuit operator that has already been analyzed, do not park + actions in node; instead introduce an N_Expression_With_Actions + and insert actions immediately. + Add guard for unexpected case of climbing up through statement + in Actions list of an N_Expression_With_Actions. + * sem_elab.adb (Insert_Elab_Check): Remove complex + specialized circuitry for the case where the context is already + analyzed, as it is not needed and introduces irregularities in + finalization. Instead rely on the above change to Insert_Actions + to ensure that late insertion on short circuit operators works + as expected. + +2014-01-22 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Operator_Check): Improve error message when an + operand of concatenation is an access type. + +2014-01-22 Thomas Quinot <quinot@adacore.com> + + * sem_dim.adb (Analyze_Dimension_Identifier): Add guard against + cascaded error. + +2014-01-22 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Find_Selected_Component): Handle properly the case + of an expanded name in a proper body, whose prefix is a package + in the context of the proper body, when there is a homonym of + the package declared in the parent unit. + +2014-01-22 Robert Dewar <dewar@adacore.com> + * sem_warn.adb (Check_Use_Clause): Don't give no entities used msg if errors found. (Check_One_Unit): Same change. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index cc5d394..d97146c 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3317,7 +3317,21 @@ package body Exp_Util is Kill_Current_Values; - if Present (Actions (P)) then + -- If P has already been expanded, we can't park new actions + -- on it, so we need to expand them immediately, introducing + -- an Expression_With_Actions. N can't be an expression + -- with actions, or else then the actions would have been + -- inserted at an inner level. + + if Analyzed (P) then + pragma Assert (Nkind (N) /= N_Expression_With_Actions); + Rewrite (N, + Make_Expression_With_Actions (Sloc (N), + Actions => Ins_Actions, + Expression => Relocate_Node (N))); + Analyze_And_Resolve (N); + + elsif Present (Actions (P)) then Insert_List_After_And_Analyze (Last (Actions (P)), Ins_Actions); else @@ -3407,8 +3421,12 @@ package body Exp_Util is -- the new actions come from the expression of the expression with -- actions, they must be added to the existing actions. The other -- alternative is when the new actions are related to one of the - -- existing actions of the expression with actions. In that case - -- they must be inserted further up the tree. + -- existing actions of the expression with actions, and should + -- never reach here: if actions are inserted on a statement within + -- the Actions of an expression with actions, or on some + -- sub-expression of such a statement, then the outermost proper + -- insertion point is right before the statement, and we should + -- never climb up as far as the N_Expression_With_Actions itself. when N_Expression_With_Actions => if N = Expression (P) then @@ -3420,6 +3438,9 @@ package body Exp_Util is (Last (Actions (P)), Ins_Actions); end if; return; + + else + raise Program_Error; end if; -- Case of appearing in the condition of a while expression or diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index f2e2d08..c212936 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6151,7 +6151,8 @@ package body Sem_Ch4 is -- In an instance a generic actual may be a numeric type even if -- the formal in the generic unit was not. In that case, the -- predefined operator was not a possible interpretation in the - -- generic, and cannot be one in the instance. + -- generic, and cannot be one in the instance, unless the operator + -- is an actual of an instance. if In_Instance and then @@ -6576,6 +6577,17 @@ package body Sem_Ch4 is if Nkind (N) /= N_Op_Concat then Error_Msg_NE ("\left operand has}!", N, Etype (L)); Error_Msg_NE ("\right operand has}!", N, Etype (R)); + + -- For concatenation operators it is more difficult to + -- determine which is the wrong operand. It is worth + -- flagging explicitly an access type, for those who + -- might think that a dereference happens here. + + elsif Is_Access_Type (Etype (L)) then + Error_Msg_N ("\left operand is access type", N); + + elsif Is_Access_Type (Etype (R)) then + Error_Msg_N ("\right operand is access type", N); end if; end if; end if; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 070d38a..bcf06a7 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5963,6 +5963,52 @@ package body Sem_Ch8 is Nam : Node_Id; + function Is_Reference_In_Subunit return Boolean; + -- In a subunit, the scope depth is not a proper measure of hiding, + -- because the context of the proper body may itself hide entities in + -- parent units. This rare case requires inspecting the tree directly + -- because the proper body is inserted in the main unit and its context + -- is simply added to that of the parent. + + ----------------------------- + -- Is_Reference_In_Subunit -- + ----------------------------- + + function Is_Reference_In_Subunit return Boolean is + Clause : Node_Id; + Comp_Unit : Node_Id; + + begin + Comp_Unit := N; + while Present (Comp_Unit) + and then Nkind (Comp_Unit) /= N_Compilation_Unit + loop + Comp_Unit := Parent (Comp_Unit); + end loop; + + if No (Comp_Unit) + or else Nkind (Unit (Comp_Unit)) /= N_Subunit + then + return False; + end if; + + -- Now check whether the package is in the context of the subunit + + Clause := First (Context_Items (Comp_Unit)); + + while Present (Clause) loop + if Nkind (Clause) = N_With_Clause + and then Entity (Name (Clause)) = P_Name + then + return True; + end if; + + Clause := Next (Clause); + end loop; + + return False; + end Is_Reference_In_Subunit; + begin Analyze (P); @@ -6244,11 +6290,13 @@ package body Sem_Ch8 is end loop; if Present (P_Name) then - Error_Msg_Sloc := Sloc (Entity (Prefix (N))); + if not Is_Reference_In_Subunit then + Error_Msg_Sloc := Sloc (Entity (Prefix (N))); - Error_Msg_NE - ("package& is hidden by declaration#", - N, P_Name); + Error_Msg_NE + ("package& is hidden by declaration#", + N, P_Name); + end if; Set_Entity (Prefix (N), P_Name); Find_Expanded_Name (N); diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 4e4f248..3d010f7 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -1909,7 +1909,13 @@ package body Sem_Dim is Analyze_Dimension_Identifier : declare Id : constant Entity_Id := Entity (N); begin - if Ekind (Id) = E_Constant + if No (Id) then + -- Abnormal tree, assume previous error + + Check_Error_Detected; + return; + + elsif Ekind (Id) = E_Constant and then Exists (Dimensions_Of (Id)) then Set_Dimensions (N, Dimensions_Of (Id)); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 4e64361..d3f9b91 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -47,8 +47,6 @@ with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; -with Sem_Res; use Sem_Res; -with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Sinput; use Sinput; @@ -2891,6 +2889,9 @@ package body Sem_Elab is Nod : Node_Id; Loc : constant Source_Ptr := Sloc (N); + Chk : Node_Id; + -- The check (N_Raise_Program_Error) node to be inserted + begin -- If expansion is disabled, do not generate any checks. Also -- skip checks if any subunits are missing because in either @@ -2914,106 +2915,35 @@ package body Sem_Elab is Nod := N; end if; + -- Build check node, possibly with condition + + Chk := Make_Raise_Program_Error (Loc, + Reason => PE_Access_Before_Elaboration); + if Present (C) then + Set_Condition (Chk, + Make_Op_Not (Loc, Right_Opnd => C)); + end if; + -- If we are inserting at the top level, insert in Aux_Decls if Nkind (Parent (Nod)) = N_Compilation_Unit then declare ADN : constant Node_Id := Aux_Decls_Node (Parent (Nod)); - R : Node_Id; begin - if No (C) then - R := - Make_Raise_Program_Error (Loc, - Reason => PE_Access_Before_Elaboration); - else - R := - Make_Raise_Program_Error (Loc, - Condition => Make_Op_Not (Loc, C), - Reason => PE_Access_Before_Elaboration); - end if; - if No (Declarations (ADN)) then - Set_Declarations (ADN, New_List (R)); + Set_Declarations (ADN, New_List (Chk)); else - Append_To (Declarations (ADN), R); + Append_To (Declarations (ADN), Chk); end if; - Analyze (R); + Analyze (Chk); end; - -- Otherwise just insert before the node in question. However, if - -- the context of the call has already been analyzed, an insertion - -- will not work if it depends on subsequent expansion (e.g. a call in - -- a branch of a short-circuit). In that case we replace the call with - -- an if expression, or with a Raise if it is unconditional. - - -- Unfortunately this does not work if the call has a dynamic size, - -- because gigi regards it as a dynamic-sized temporary. If such a call - -- appears in a short-circuit expression, the elaboration check will be - -- missed (rare enough ???). Otherwise, the code below inserts the check - -- at the appropriate place before the call. Same applies in the even - -- rarer case the return type has a known size but is unconstrained. + -- Otherwise just insert as an action on the node in question else - if Nkind (N) = N_Function_Call - and then Analyzed (Parent (N)) - and then Size_Known_At_Compile_Time (Etype (N)) - and then - (not Has_Discriminants (Etype (N)) - or else Is_Constrained (Etype (N))) - - then - declare - Typ : constant Entity_Id := Etype (N); - Chk : constant Boolean := Do_Range_Check (N); - - R : constant Node_Id := - Make_Raise_Program_Error (Loc, - Reason => PE_Access_Before_Elaboration); - - Reloc_N : Node_Id; - - begin - Set_Etype (R, Typ); - - if No (C) then - Rewrite (N, R); - - else - Reloc_N := Relocate_Node (N); - Save_Interps (N, Reloc_N); - Rewrite (N, - Make_If_Expression (Loc, - Expressions => New_List (C, Reloc_N, R))); - end if; - - Analyze_And_Resolve (N, Typ); - - -- If the original call requires a range check, so does the - -- if expression. - - if Chk then - Enable_Range_Check (N); - else - Set_Do_Range_Check (N, False); - end if; - end; - - else - if No (C) then - Insert_Action (Nod, - Make_Raise_Program_Error (Loc, - Reason => PE_Access_Before_Elaboration)); - else - Insert_Action (Nod, - Make_Raise_Program_Error (Loc, - Condition => - Make_Op_Not (Loc, - Right_Opnd => C), - Reason => PE_Access_Before_Elaboration)); - end if; - end if; + Insert_Action (Nod, Chk); end if; end Insert_Elab_Check; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 53be17c..07ad998 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2635,8 +2635,14 @@ package body Sem_Prag is Collect_States_And_Variables; + -- All done if result is null + + if Nkind (Inits) = N_Null then + return; + end if; + -- Single and multiple initialization clauses must appear as an - -- aggregate. If this is not the case, then either the parser of + -- aggregate. If this is not the case, then either the parser or -- the analysis of the pragma failed to produce an aggregate. pragma Assert (Nkind (Inits) = N_Aggregate); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index fe4000a..8259976 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -4,7 +4,7 @@ -- -- -- S N A M E S -- -- -- --- T e m p l a t e -- +-- S p e c -- -- -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- |