diff options
Diffstat (limited to 'gcc/ada/par-ch3.adb')
| -rw-r--r-- | gcc/ada/par-ch3.adb | 217 |
1 files changed, 207 insertions, 10 deletions
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 78a3ebd..52e52dc 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -27,7 +27,7 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram body ordering check. Subprograms are in order -- by RM section rather than alphabetical. -with Sinfo.CN; use Sinfo.CN; +with Sinfo.CN; use Sinfo.CN; separate (Par) @@ -1379,9 +1379,9 @@ package body Ch3 is procedure No_List is begin if Num_Idents > 1 then - Error_Msg + Error_Msg_N ("identifier list not allowed for RENAMES", - Sloc (Idents (2))); + Idents (2)); end if; List_OK := False; @@ -1486,7 +1486,7 @@ package body Ch3 is -- access_definition elsif Token = Tok_Renames then - Error_Msg_Ada_2020_Feature + Error_Msg_Ada_2022_Feature ("object renaming without subtype", Token_Ptr); Scan; -- past renames @@ -2693,6 +2693,73 @@ package body Ch3 is Scan_State : Saved_Scan_State; Aliased_Present : Boolean := False; + procedure P_Index_Subtype_Def_With_Fixed_Lower_Bound + (Subtype_Mark : Node_Id); + -- Parse an unconstrained index range with a fixed lower bound: + -- subtype_mark range <expression> .. <> + -- This procedure creates a subtype_indication node for the index. + + -------------------------------------------- + -- P_Index_Range_With_Fixed_Lower_Bound -- + -------------------------------------------- + + procedure P_Index_Subtype_Def_With_Fixed_Lower_Bound + (Subtype_Mark : Node_Id) + is + Low_Expr_Node : constant Node_Id := P_Expression; + High_Expr_Node : Node_Id; + Indic_Node : Node_Id; + Constr_Node : Node_Id; + Range_Node : Node_Id; + + begin + T_Dot_Dot; -- Error if no .. + + -- A box is required at this point, and we'll set the upper bound to + -- the same expression as the lower bound (see further below), to + -- avoid problems with trying to analyze an Empty node. Analysis can + -- still tell that this is a fixed-lower-bound range because the + -- index is represented by a subtype_indication in an unconstrained + -- array type definition. + + if Token = Tok_Box then + Scan; + High_Expr_Node := Low_Expr_Node; + + -- Error if no <> was found, and try to parse an expression since + -- it's likely one was given in place of the <>. + + else + Error_Msg_AP -- CODEFIX + ("missing ""'<'>"""); + + High_Expr_Node := P_Expression; + end if; + + Constr_Node := New_Node (N_Range_Constraint, Token_Ptr); + Range_Node := New_Node (N_Range, Token_Ptr); + Set_Range_Expression (Constr_Node, Range_Node); + + Check_Simple_Expression (Low_Expr_Node); + + Set_Low_Bound (Range_Node, Low_Expr_Node); + Set_High_Bound (Range_Node, High_Expr_Node); + + Indic_Node := + New_Node (N_Subtype_Indication, Sloc (Subtype_Mark)); + Set_Subtype_Mark (Indic_Node, Check_Subtype_Mark (Subtype_Mark)); + Set_Constraint (Indic_Node, Constr_Node); + + Append (Indic_Node, Subs_List); + end P_Index_Subtype_Def_With_Fixed_Lower_Bound; + + -- Local variables + + Is_Constrained_Array_Def : Boolean := True; + Subtype_Mark_Node : Node_Id; + + -- Start of processing for P_Array_Type_Definition + begin Array_Loc := Token_Ptr; Scan; -- past ARRAY @@ -2724,17 +2791,125 @@ package body Ch3 is Def_Node := New_Node (N_Unconstrained_Array_Definition, Array_Loc); Restore_Scan_State (Scan_State); -- to first subtype mark + Is_Constrained_Array_Def := False; + + -- Now parse a sequence of indexes where each is either of form: + -- <subtype_mark> range <> + -- or + -- <subtype_mark> range <expr> .. <> + -- + -- The latter syntax indicates an index with a fixed lower bound, + -- and only applies when extensions are enabled (-gnatX). + loop - Append (P_Subtype_Mark_Resync, Subs_List); + Subtype_Mark_Node := P_Subtype_Mark_Resync; + T_Range; - T_Box; + + -- Normal "subtype_mark range <>" form, so simply append + -- the subtype reference. + + if Token = Tok_Box then + Append (Subtype_Mark_Node, Subs_List); + Scan; + + -- Fixed-lower-bound form ("subtype_mark range <expr> .. <>") + + else + P_Index_Subtype_Def_With_Fixed_Lower_Bound (Subtype_Mark_Node); + + if not Extensions_Allowed then + Error_Msg_N + ("fixed-lower-bound array is an extension feature; " + & "use -gnatX", + Token_Node); + end if; + end if; + exit when Token = Tok_Right_Paren or else Token = Tok_Of; T_Comma; end loop; Set_Subtype_Marks (Def_Node, Subs_List); - else + -- If we don't have "range <>", then "range" will be followed by an + -- expression, for either a normal range or a fixed-lower-bound range + -- ("<exp> .. <>"), and we have to know which, in order to determine + -- whether to parse the indexes for an unconstrained or constrained + -- array definition. So we look ahead to see if "<>" follows the "..". + -- If not, then this must be a discrete_subtype_indication for a + -- constrained_array_definition, which will be processed further below. + + elsif Prev_Token = Tok_Range + and then Token /= Tok_Right_Paren and then Token /= Tok_Comma + then + -- If we have an expression followed by "..", then scan farther + -- and check for "<>" to see if we have a fixed-lower-bound range. + + if P_Expression_Or_Range_Attribute /= Error + and then Expr_Form /= EF_Range_Attr + and then Token = Tok_Dot_Dot + then + Scan; + + -- If there's a "<>", then we know we have a fixed-lower-bound + -- index, so we can proceed with parsing an unconstrained array + -- definition. + + if Token = Tok_Box then + Is_Constrained_Array_Def := False; + + Def_Node := + New_Node (N_Unconstrained_Array_Definition, Array_Loc); + + Restore_Scan_State (Scan_State); -- to first subtype mark + + -- Now parse a sequence of indexes where each is either of + -- form: + -- <subtype_mark> range <> + -- or + -- <subtype_mark> range <expr> .. <> + -- + -- The latter indicates an index with a fixed lower bound, + -- and only applies when extensions are enabled (-gnatX). + + loop + Subtype_Mark_Node := P_Subtype_Mark_Resync; + + T_Range; + + -- Normal "subtype_mark range <>" form, so simply append + -- the subtype reference. + + if Token = Tok_Box then + Append (Subtype_Mark_Node, Subs_List); + Scan; + + -- This must be an index of form: + -- <subtype_mark> range <expr> .. <>" + + else + P_Index_Subtype_Def_With_Fixed_Lower_Bound + (Subtype_Mark_Node); + + if not Extensions_Allowed then + Error_Msg_N + ("fixed-lower-bound array is an extension feature; " + & "use -gnatX", + Token_Node); + end if; + end if; + + exit when Token = Tok_Right_Paren or else Token = Tok_Of; + T_Comma; + end loop; + + Set_Subtype_Marks (Def_Node, Subs_List); + end if; + end if; + end if; + + if Is_Constrained_Array_Def then Def_Node := New_Node (N_Constrained_Array_Definition, Array_Loc); Restore_Scan_State (Scan_State); -- to first discrete range @@ -3217,8 +3392,30 @@ package body Ch3 is Constr_Node := New_Node (N_Range, Token_Ptr); Set_Low_Bound (Constr_Node, Expr_Node); Scan; -- past .. - Expr_Node := P_Expression; - Check_Simple_Expression (Expr_Node); + + -- If the upper bound is given by "<>", this is an index for + -- a fixed-lower-bound subtype, so set the expression to Empty + -- for now (it will be set to the ranges maximum upper bound + -- later during analysis), and scan to the next token. + + if Token = Tok_Box then + if not Extensions_Allowed then + Error_Msg_N + ("fixed-lower-bound array is an extension feature; " + & "use -gnatX", + Expr_Node); + end if; + + Expr_Node := Empty; + Scan; + + -- Otherwise parse the range's upper bound expression + + else + Expr_Node := P_Expression; + Check_Simple_Expression (Expr_Node); + end if; + Set_High_Bound (Constr_Node, Expr_Node); Append (Constr_Node, Constr_List); goto Loop_Continue; |