Commit f92f17e6 by Ed Schonberg Committed by Arnaud Charlet

par-ch12.adb (P_Generic_Associations): The source position of an Others…

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
parent c7ce71c2
......@@ -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;
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment