From 14f3895c40cd3f074ca17823c30a6cbf665836b5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 27 Apr 2016 14:56:41 +0200 Subject: [PATCH] [multiple changes] 2016-04-27 Hristian Kirtchev * sem_ch3.adb: Minor reformatting. 2016-04-27 Ed Schonberg * sem_dim.adb (Analyze_Dimension, case N_Identifier): Check that identifier has a usable type before analysis, to handle properly identifiers introduced after some lexical/syntactic recovery that created new identifiers. From-SVN: r235498 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/sem_ch3.adb | 47 ++++++++++++++++++++++++--------------------- gcc/ada/sem_dim.adb | 9 ++++++++- 3 files changed, 44 insertions(+), 23 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a4a1c09e22fa..39ec57e6a953 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2016-04-27 Hristian Kirtchev + + * sem_ch3.adb: Minor reformatting. + +2016-04-27 Ed Schonberg + + * sem_dim.adb (Analyze_Dimension, case N_Identifier): Check + that identifier has a usable type before analysis, to handle + properly identifiers introduced after some lexical/syntactic + recovery that created new identifiers. + 2016-04-27 Bob Duff * a-coinve.adb, a-comutr.adb, a-conhel.adb, a-convec.adb, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0d378ec082fd..cde4d1a73a8b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -13033,15 +13033,13 @@ package body Sem_Ch3 is Related_Nod : Node_Id; For_Access : Boolean := False) is - E : Entity_Id := Entity (Subtype_Mark (S)); - T : Entity_Id; - C : Node_Id; - Elist : Elist_Id := New_Elmt_List; + E : Entity_Id := Entity (Subtype_Mark (S)); + T : Entity_Id; procedure Fixup_Bad_Constraint; - -- This is called after finding a bad constraint, and after having - -- posted an appropriate error message. The mission is to leave the - -- entity T in as reasonable state as possible. + -- Called after finding a bad constraint, and after having posted an + -- appropriate error message. The goal is to leave type Def_Id in as + -- reasonable state as possiblet. -------------------------- -- Fixup_Bad_Constraint -- @@ -13065,6 +13063,11 @@ package body Sem_Ch3 is Set_Error_Posted (Def_Id); end Fixup_Bad_Constraint; + -- Local variables + + C : Node_Id; + Constr : Elist_Id := New_Elmt_List; + -- Start of processing for Constrain_Discriminated_Type begin @@ -13091,27 +13094,27 @@ package body Sem_Ch3 is and then Present (Full_View (T)) and then (Has_Unknown_Discriminants (T) - or else (not Has_Discriminants (T) - and then Has_Discriminants (Full_View (T)) - and then Present - (Discriminant_Default_Value - (First_Discriminant (Full_View (T)))))) + or else + (not Has_Discriminants (T) + and then Has_Discriminants (Full_View (T)) + and then Present (Discriminant_Default_Value + (First_Discriminant (Full_View (T)))))) then T := Full_View (T); E := Full_View (E); end if; - -- Ada 2005 (AI-412): Constrained incomplete subtypes are illegal. - -- Avoid generating an error for access-to-incomplete subtypes. + -- Ada 2005 (AI-412): Constrained incomplete subtypes are illegal. Avoid + -- generating an error for access-to-incomplete subtypes. if Ada_Version >= Ada_2005 and then Ekind (T) = E_Incomplete_Type and then Nkind (Parent (S)) = N_Subtype_Declaration and then not Is_Itype (Def_Id) then - -- A little sanity check, emit an error message if the type - -- has discriminants to begin with. Type T may be a regular - -- incomplete type or imported via a limited with clause. + -- A little sanity check, emit an error message if the type has + -- discriminants to begin with. Type T may be a regular incomplete + -- type or imported via a limited with clause. if Has_Discriminants (T) or else (From_Limited_With (T) @@ -13152,23 +13155,23 @@ package body Sem_Ch3 is return; end if; - -- T may be an unconstrained subtype (e.g. a generic actual). - -- Constraint applies to the base type. + -- T may be an unconstrained subtype (e.g. a generic actual). Constraint + -- applies to the base type. T := Base_Type (T); - Elist := Build_Discriminant_Constraints (T, S); + Constr := Build_Discriminant_Constraints (T, S); -- If the list returned was empty we had an error in building the -- discriminant constraint. We have also already signalled an error -- in the incomplete type case - if Is_Empty_Elmt_List (Elist) then + if Is_Empty_Elmt_List (Constr) then Fixup_Bad_Constraint; return; end if; - Build_Discriminated_Subtype (T, Def_Id, Elist, Related_Nod, For_Access); + Build_Discriminated_Subtype (T, Def_Id, Constr, Related_Nod, For_Access); end Constrain_Discriminated_Type; --------------------------- diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 4a9201570bdf..c7282b1f265c 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -1143,7 +1143,6 @@ package body Sem_Dim is N_Expanded_Name | N_Explicit_Dereference | N_Function_Call | - N_Identifier | N_Indexed_Component | N_Qualified_Expression | N_Selected_Component | @@ -1152,6 +1151,14 @@ package body Sem_Dim is N_Unchecked_Type_Conversion => Analyze_Dimension_Has_Etype (N); + -- In the presence of a repaired syntax error, an identifier + -- may be introduced without a usable type. + + when N_Identifier => + if Present (Etype (N)) then + Analyze_Dimension_Has_Etype (N); + end if; + when N_Number_Declaration => Analyze_Dimension_Number_Declaration (N); -- 2.47.2