par-ch12.adb (P_Generic_Associations): The source position of an Others association is that of the others keyword...

2007-04-20  Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* 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

2 files changed, 39 insertions, 17 deletions

diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 84be97a..d71b40d 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 b284b30..54c5149 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;