From f92f17e6e943377eb2e7b43f5de31ceda409c6cc Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 6 Jun 2007 12:40:12 +0200 Subject: [PATCH] par-ch12.adb (P_Generic_Associations): The source position of an Others association is that of the others keyword... 2007-04-20 Ed Schonberg Robert Dewar * par-ch12.adb (P_Generic_Associations): The source position of an Others association is that of the others keyword, not that of the token that follows the box. (P_Formal_Type_Definition): Handle formal access types that carry a not null indicator. * par-ch3.adb (P_Known_Discriminant_Part_Opt, P_Component_Items): If multiple identifier are present, save Scan_State before scanning the colon, to ensure that separate trees are constructed for each declaration. (P_Identifier_Declarations): For object declaration, set new flag Has_Init_Expression if initialization expression present. (P_Null_Exclusion): Properly diagnose NOT NULL coming before NULL Improve NOT NULL error messages From-SVN: r125439 --- gcc/ada/par-ch12.adb | 18 ++++++++++++++++-- gcc/ada/par-ch3.adb | 38 +++++++++++++++++++++++--------------- 2 files changed, 39 insertions(+), 17 deletions(-) diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 84be97a708d..d71b40d8f8e 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -338,7 +338,7 @@ package body Ch12 is if Ada_Version < Ada_05 then Error_Msg_SP ("partial parametrization of formal packages" & - " is an Ada 2005 extension"); + " is an Ada 2005 extension"); Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); end if; @@ -357,7 +357,9 @@ package body Ch12 is Scan; -- past box end if; - return New_Node (N_Others_Choice, Token_Ptr); + -- Source position of the others choice is beginning of construct + + return New_Node (N_Others_Choice, Sloc (Generic_Assoc_Node)); end if; if Token in Token_Class_Desig then @@ -679,6 +681,18 @@ package body Ch12 is when Tok_New => return P_Formal_Derived_Type_Definition; + when Tok_Not => + if P_Null_Exclusion then + Typedef_Node := P_Access_Type_Definition; + Set_Null_Exclusion_Present (Typedef_Node); + return Typedef_Node; + + else + Error_Msg_SC ("expect valid formal access definition!"); + Resync_Past_Semicolon; + return Error; + end if; + when Tok_Private | Tok_Tagged => return P_Formal_Private_Type_Definition; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index b284b307413..54c514911f6 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -941,11 +941,12 @@ package body Ch3 is -- Ada 2005 (AI-441, AI-447): null_exclusion is illegal in Ada 95, -- except in the case of anonymous access types. - -- Allow_Anonymous_In_95 will be True if we're parsing a - -- formal parameter or discriminant, which are the only places - -- where anonymous access types occur in Ada 95. "Formal : not - -- null access ..." is legal in Ada 95, whereas "Formal : not - -- null Named_Access_Type" is not. + + -- Allow_Anonymous_In_95 will be True if we're parsing a formal + -- parameter or discriminant, which are the only places where + -- anonymous access types occur in Ada 95. "Formal : not null + -- access ..." is legal in Ada 95, whereas "Formal : not null + -- Named_Access_Type" is not. if Ada_Version >= Ada_05 or else (Ada_Version >= Ada_95 @@ -956,7 +957,7 @@ package body Ch3 is else Error_Msg - ("null-excluding access is an Ada 2005 extension", Not_Loc); + ("`NOT NULL` access type is an Ada 2005 extension", Not_Loc); Error_Msg ("\unit should be compiled with -gnat05 switch", Not_Loc); end if; @@ -965,6 +966,10 @@ package body Ch3 is Error_Msg_SP ("NULL expected"); end if; + if Token = Tok_New then + Error_Msg ("`NOT NULL` comes after NEW, not before", Not_Loc); + end if; + return True; end if; end P_Null_Exclusion; @@ -1014,7 +1019,7 @@ package body Ch3 is return Subtype_Mark; else if Not_Null_Present then - Error_Msg_SP ("constrained null-exclusion not allowed"); + Error_Msg_SP ("`NOT NULL` not allowed if constraint given"); end if; Indic_Node := New_Node (N_Subtype_Indication, Sloc (Subtype_Mark)); @@ -1471,8 +1476,8 @@ package body Ch3 is if Present (Init_Expr) then if Not_Null_Present then - Error_Msg_SP ("null-exclusion not allowed in " - & "numeric expression"); + Error_Msg_SP + ("`NOT NULL` not allowed in numeric expression"); end if; Decl_Node := New_Node (N_Number_Declaration, Ident_Sloc); @@ -1638,7 +1643,7 @@ package body Ch3 is if Token_Is_Renames then if Ada_Version < Ada_05 then Error_Msg_SP - ("null-exclusion not allowed in object renaming"); + ("`NOT NULL` not allowed in object renaming"); raise Error_Resync; -- Ada 2005 (AI-423): Object renaming declaration with @@ -1745,6 +1750,7 @@ package body Ch3 is if Present (Init_Expr) then if Nkind (Decl_Node) = N_Object_Declaration then Set_Expression (Decl_Node, Init_Expr); + Set_Has_Init_Expression (Decl_Node); else Error_Msg ("initialization not allowed here", Init_Loc); end if; @@ -2782,8 +2788,6 @@ package body Ch3 is Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); end loop; - T_Colon; - -- If there are multiple identifiers, we repeatedly scan the -- type and initialization expression information by resetting -- the scan pointer (so that we get completely separate trees @@ -2793,6 +2797,8 @@ package body Ch3 is Save_Scan_State (Scan_State); end if; + T_Colon; + -- Loop through defining identifiers in list Ident := 1; @@ -2836,6 +2842,7 @@ package body Ch3 is exit Ident_Loop when Ident = Num_Idents; Ident := Ident + 1; Restore_Scan_State (Scan_State); + T_Colon; end loop Ident_Loop; exit Specification_Loop when Token /= Tok_Semicolon; @@ -3261,8 +3268,6 @@ package body Ch3 is Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); end loop; - T_Colon; - -- If there are multiple identifiers, we repeatedly scan the -- type and initialization expression information by resetting -- the scan pointer (so that we get completely separate trees @@ -3272,6 +3277,8 @@ package body Ch3 is Save_Scan_State (Scan_State); end if; + T_Colon; + -- Loop through defining identifiers in list Ident := 1; @@ -3359,6 +3366,7 @@ package body Ch3 is exit Ident_Loop when Ident = Num_Idents; Ident := Ident + 1; Restore_Scan_State (Scan_State); + T_Colon; end loop Ident_Loop; -- 2.30.2