X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fpar-ch3.adb;h=bfc4f592bf36af68761e31f59189d6ef87e85587;hb=4c97a37dc04bd1838ea3d099bebf2900e10322dd;hp=9cca962a0693f09a1680a9f85f82afd445ebd638;hpb=30e864df6d529a64c380fc365bdc8f9368cf5e51;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 9cca962a069..bfc4f592bf3 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -124,8 +124,7 @@ package body Ch3 is elsif Nkind_In (N, N_In, N_Not_In) and then Paren_Count (N) = 0 then - Error_Msg_N - ("|this expression must be parenthesized in Ada 2012 mode!", N); + Error_Msg_N ("|this expression must be parenthesized!", N); end if; end Check_Restricted_Expression; @@ -211,24 +210,10 @@ package body Ch3 is -- we set Force_Msg to True, since we want at least one message for each -- separate declaration (but not use) of a reserved identifier. - if Token = Tok_Identifier then - - -- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE, - -- OVERRIDING, and SYNCHRONIZED are new reserved words. Note that - -- in the case where these keywords are misused in Ada 95 mode, - -- this routine will generally not be called at all. + -- Duplication should be removed, common code should be factored??? - if Ada_Version = Ada_95 - and then Warn_On_Ada_2005_Compatibility - then - if Token_Name = Name_Overriding - or else Token_Name = Name_Synchronized - or else (Token_Name = Name_Interface - and then Prev_Token /= Tok_Pragma) - then - Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node); - end if; - end if; + if Token = Tok_Identifier then + Check_Future_Keyword; -- If we have a reserved identifier, manufacture an identifier with -- a corresponding name after posting an appropriate error message @@ -251,9 +236,7 @@ package body Ch3 is -- and we need to fix it. if Nkind (Ident_Node) = N_Defining_Identifier then - Ident_Node := - Make_Identifier (Sloc (Ident_Node), - Chars => Chars (Ident_Node)); + Ident_Node := Make_Identifier (Sloc (Ident_Node), Chars (Ident_Node)); end if; -- Change identifier to defining identifier if not in error @@ -309,11 +292,11 @@ package body Ch3 is -- Error recovery: can raise Error_Resync - -- Note: The processing for full type declaration, incomplete type - -- declaration, private type declaration and type definition is - -- included in this function. The processing for concurrent type - -- declarations is NOT here, but rather in chapter 9 (i.e. this - -- function handles only declarations starting with TYPE). + -- The processing for full type declarations, incomplete type declarations, + -- private type declarations and type definitions is included in this + -- function. The processing for concurrent type declarations is NOT here, + -- but rather in chapter 9 (this function handles only declarations + -- starting with TYPE). function P_Type_Declaration return Node_Id is Abstract_Present : Boolean := False; @@ -506,9 +489,7 @@ package body Ch3 is when Tok_Left_Paren => Typedef_Node := P_Enumeration_Type_Definition; - End_Labl := - Make_Identifier (Token_Ptr, - Chars => Chars (Ident_Node)); + End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node)); Set_Comes_From_Source (End_Labl, False); Set_End_Label (Typedef_Node, End_Labl); @@ -524,9 +505,7 @@ package body Ch3 is if Nkind (Typedef_Node) = N_Derived_Type_Definition and then Present (Record_Extension_Part (Typedef_Node)) then - End_Labl := - Make_Identifier (Token_Ptr, - Chars => Chars (Ident_Node)); + End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node)); Set_Comes_From_Source (End_Labl, False); Set_End_Label @@ -542,9 +521,7 @@ package body Ch3 is when Tok_Record => Typedef_Node := P_Record_Definition; - End_Labl := - Make_Identifier (Token_Ptr, - Chars => Chars (Ident_Node)); + End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node)); Set_Comes_From_Source (End_Labl, False); Set_End_Label (Typedef_Node, End_Labl); @@ -599,8 +576,7 @@ package body Ch3 is Set_Limited_Present (Typedef_Node, True); End_Labl := - Make_Identifier (Token_Ptr, - Chars => Chars (Ident_Node)); + Make_Identifier (Token_Ptr, Chars (Ident_Node)); Set_Comes_From_Source (End_Labl, False); Set_End_Label (Typedef_Node, End_Labl); @@ -622,8 +598,7 @@ package body Ch3 is Set_Tagged_Present (Typedef_Node, True); End_Labl := - Make_Identifier (Token_Ptr, - Chars => Chars (Ident_Node)); + Make_Identifier (Token_Ptr, Chars (Ident_Node)); Set_Comes_From_Source (End_Labl, False); Set_End_Label (Typedef_Node, End_Labl); @@ -658,7 +633,7 @@ package body Ch3 is Error_Msg_SP ("(Ada 83) limited record declaration not allowed!"); - -- In Ada2005, "abstract limited" can appear before "new", + -- In Ada 2005, "abstract limited" can appear before "new", -- but it cannot be part of an untagged record declaration. elsif Abstract_Present @@ -706,8 +681,7 @@ package body Ch3 is and then Present (Record_Extension_Part (Typedef_Node)) then End_Labl := - Make_Identifier (Token_Ptr, - Chars => Chars (Ident_Node)); + Make_Identifier (Token_Ptr, Chars (Ident_Node)); Set_Comes_From_Source (End_Labl, False); Set_End_Label @@ -770,6 +744,22 @@ package body Ch3 is when Tok_Private => Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc); Scan; -- past PRIVATE + + -- Check error cases of private [abstract] tagged + + if Token = Tok_Abstract then + Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE"); + Scan; -- past ABSTRACT + + if Token = Tok_Tagged then + Scan; -- past TAGGED + end if; + + elsif Token = Tok_Tagged then + Error_Msg_SC ("TAGGED must come before PRIVATE"); + Scan; -- past TAGGED + end if; + exit; -- Ada 2005 (AI-345): Protected, synchronized or task interface @@ -937,7 +927,8 @@ package body Ch3 is -------------------------------- -- SUBTYPE_DECLARATION ::= - -- subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION; + -- subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION + -- {ASPECT_SPECIFICATIONS]; -- The caller has checked that the initial token is SUBTYPE @@ -1069,7 +1060,11 @@ package body Ch3 is begin Constr_Node := P_Constraint_Opt; - if No (Constr_Node) then + if No (Constr_Node) + or else + (Nkind (Constr_Node) = N_Range_Constraint + and then Nkind (Range_Expression (Constr_Node)) = N_Error) + then return Subtype_Mark; else if Not_Null_Present then @@ -2284,13 +2279,30 @@ package body Ch3 is Scan; -- past RANGE end if; - Expr_Node := P_Expression; - Check_Simple_Expression (Expr_Node); - Set_Low_Bound (Typedef_Node, Expr_Node); - T_Dot_Dot; - Expr_Node := P_Expression; - Check_Simple_Expression (Expr_Node); - Set_High_Bound (Typedef_Node, Expr_Node); + Expr_Node := P_Expression_Or_Range_Attribute; + + -- Range case (not permitted by the grammar, this is surprising but + -- the grammar in the RM is as quoted above, and does not allow Range). + + if Expr_Form = EF_Range_Attr then + Error_Msg_N + ("Range attribute not allowed here, use First .. Last", Expr_Node); + Set_Low_Bound (Typedef_Node, Expr_Node); + Set_Attribute_Name (Expr_Node, Name_First); + Set_High_Bound (Typedef_Node, Copy_Separate_Tree (Expr_Node)); + Set_Attribute_Name (High_Bound (Typedef_Node), Name_Last); + + -- Normal case of explicit range + + else + Check_Simple_Expression (Expr_Node); + Set_Low_Bound (Typedef_Node, Expr_Node); + T_Dot_Dot; + Expr_Node := P_Expression; + Check_Simple_Expression (Expr_Node); + Set_High_Bound (Typedef_Node, Expr_Node); + end if; + return Typedef_Node; end P_Signed_Integer_Type_Definition; @@ -2514,6 +2526,7 @@ package body Ch3 is -- Note: this is an obsolescent feature in Ada 95 (I.3) -- Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION + -- (also true in formal modes). -- The caller has checked that the initial token is DELTA @@ -2528,6 +2541,7 @@ package body Ch3 is Scan; -- past DELTA Expr_Node := P_Expression; Check_Simple_Expression_In_Ada_83 (Expr_Node); + Set_Delta_Expression (Constraint_Node, Expr_Node); if Token = Tok_Range then @@ -2652,9 +2666,12 @@ package body Ch3 is Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); end if; - if Aliased_Present then - Error_Msg_SP ("ALIASED not allowed here"); - end if; + -- AI95-406 makes "aliased" legal (and useless) in this context so + -- followintg code which used to be needed is commented out. + + -- if Aliased_Present then + -- Error_Msg_SP ("ALIASED not allowed here"); + -- end if; Set_Subtype_Indication (CompDef_Node, Empty); Set_Aliased_Present (CompDef_Node, False); @@ -2762,11 +2779,17 @@ package body Ch3 is Set_High_Bound (Range_Node, Expr_Node); return Range_Node; - -- Otherwise we must have a subtype mark + -- Otherwise we must have a subtype mark, or an Ada 2012 iterator elsif Expr_Form = EF_Simple_Name then return Expr_Node; + -- The domain of iteration must be a name. Semantics will determine that + -- the expression has the proper form. + + elsif Ada_Version >= Ada_2012 then + return Expr_Node; + -- If incorrect, complain that we expect .. else @@ -3421,9 +3444,12 @@ package body Ch3 is Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); end if; - if Aliased_Present then - Error_Msg_SP ("ALIASED not allowed here"); - end if; + -- AI95-406 makes "aliased" legal (and useless) here, so the + -- following code which used to be required is commented out. + + -- if Aliased_Present then + -- Error_Msg_SP ("ALIASED not allowed here"); + -- end if; Set_Subtype_Indication (CompDef_Node, Empty); Set_Aliased_Present (CompDef_Node, False); @@ -3659,7 +3685,7 @@ package body Ch3 is else -- In Ada 2012 mode, the expression must be a simple - -- expression. The resaon for this restriction (i.e. going + -- expression. The reason for this restriction (i.e. going -- back to the Ada 83 rule) is to avoid ambiguities when set -- membership operations are allowed, consider the -- following: @@ -3667,7 +3693,7 @@ package body Ch3 is -- when A in 1 .. 10 | 12 => -- This is ambiguous without parentheses, so we require one - -- of the following two parenthesized forms to disambuguate: + -- of the following two parenthesized forms to disambiguate: -- one of the following: @@ -3700,13 +3726,23 @@ package body Ch3 is end if; if Token = Tok_Comma then - Error_Msg_SC -- CODEFIX - (""","" should be ""'|"""); + Scan; -- past comma + + if Token = Tok_Vertical_Bar then + Error_Msg_SP -- CODEFIX + ("|extra "","" ignored"); + Scan; -- past | + + else + Error_Msg_SP -- CODEFIX + (""","" should be ""'|"""); + end if; + else exit when Token /= Tok_Vertical_Bar; + Scan; -- past | end if; - Scan; -- past | or comma end loop; return Choices; @@ -3758,7 +3794,7 @@ package body Ch3 is -- Ada 2005 (AI-345): In case of interfaces with a null list of -- interfaces we build a record_definition node. - if Token = Tok_Semicolon then + if Token = Tok_Semicolon or else Aspect_Specifications_Present then Typedef_Node := New_Node (N_Record_Definition, Token_Ptr); Set_Abstract_Present (Typedef_Node); @@ -4193,7 +4229,7 @@ package body Ch3 is P_Identifier_Declarations (Decls, Done, In_Spec); end if; - -- Ada2005: A subprogram declaration can start with "not" or + -- Ada 2005: A subprogram declaration can start with "not" or -- "overriding". In older versions, "overriding" is handled -- like an identifier, with the appropriate messages. @@ -4250,8 +4286,42 @@ package body Ch3 is when Tok_With => Check_Bad_Layout; - Error_Msg_SC ("WITH can only appear in context clause"); - raise Error_Resync; + + if Aspect_Specifications_Present then + + -- If we are after a semicolon, complain that it was ignored. + -- But we don't really ignore it, since we dump the aspects, + -- so we make the error message a normal fatal message which + -- will inhibit semantic analysis anyway). + + if Prev_Token = Tok_Semicolon then + Error_Msg_SP -- CODEFIX + ("extra "";"" ignored"); + + -- If not just past semicolon, just complain that aspects are + -- not allowed at this point. + + else + Error_Msg_SC ("aspect specifications not allowed here"); + end if; + + declare + Dummy_Node : constant Node_Id := + New_Node (N_Package_Specification, Token_Ptr); + pragma Warnings (Off, Dummy_Node); + -- Dummy node to attach aspect specifications to. We will + -- then throw them away. + + begin + P_Aspect_Specifications (Dummy_Node, Semicolon => True); + end; + + -- Here if not aspect specifications case + + else + Error_Msg_SC ("WITH can only appear in context clause"); + raise Error_Resync; + end if; -- BEGIN terminates the scan of a sequence of declarations unless -- there is a missing subprogram body, see section on handling