[Ada] Syntax error on "not null procedure"

gcc/ada/

	* par-ch3.adb (P_Access_Type_Definition): If Not_Null_Subtype is
	True, give an error in the access-to-subprogram cases.
This commit is contained in:
Bob Duff 2021-11-17 09:58:49 -05:00 committed by Pierre-Marie de Rodat
parent 70b29d02f4
commit 1010cb00c8
1 changed files with 37 additions and 20 deletions

View File

@ -4201,14 +4201,6 @@ package body Ch3 is
function P_Access_Type_Definition
(Header_Already_Parsed : Boolean := False) return Node_Id
is
Access_Loc : constant Source_Ptr := Token_Ptr;
Prot_Flag : Boolean;
Not_Null_Present : Boolean := False;
Not_Null_Subtype : Boolean := False;
Type_Def_Node : Node_Id;
Result_Not_Null : Boolean;
Result_Node : Node_Id;
procedure Check_Junk_Subprogram_Name;
-- Used in access to subprogram definition cases to check for an
-- identifier or operator symbol that does not belong.
@ -4235,22 +4227,32 @@ package body Ch3 is
end if;
end Check_Junk_Subprogram_Name;
Access_Loc : constant Source_Ptr := Token_Ptr;
Prot_Flag : Boolean;
Not_Null_Present : Boolean := False;
Not_Null_Subtype : Boolean := False;
Not_Null_Subtype_Loc : Source_Ptr; -- loc of second "not null"
Type_Def_Node : Node_Id;
Result_Not_Null : Boolean;
Result_Node : Node_Id;
-- Start of processing for P_Access_Type_Definition
begin
if not Header_Already_Parsed then
-- NOT NULL ACCESS... is a common form of access definition. ACCESS
-- NOT NULL... is certainly rare, but syntactically legal. NOT NULL
-- ACCESS NOT NULL... is rarer yet, and also legal. The last two
-- cases are only meaningful if the following subtype indication
-- denotes an access type. We check below for "not null procedure"
-- and "not null function"; in the access-to-object case it is a
-- semantic check. The flag Not_Null_Subtype indicates that this
-- second null exclusion is present in the access type definition.
-- NOT NULL ACCESS .. is a common form of access definition.
-- ACCESS NOT NULL .. is certainly rare, but syntactically legal.
-- NOT NULL ACCESS NOT NULL .. is rarer yet, and also legal.
-- The last two cases are only meaningful if the following subtype
-- indication denotes an access type (semantic check). The flag
-- Not_Null_Subtype indicates that this second null exclusion is
-- present in the access type definition.
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
Scan; -- past ACCESS
Not_Null_Subtype := P_Null_Exclusion; -- Might also appear
Not_Null_Subtype_Loc := Token_Ptr;
Not_Null_Subtype := P_Null_Exclusion; -- Might also appear
end if;
if Token_Name = Name_Protected then
@ -4269,6 +4271,20 @@ package body Ch3 is
end if;
end if;
-- Access-to-subprogram case
if Token in Tok_Procedure | Tok_Function then
-- Check for "not null [protected] procedure" and "not null
-- [protected] function".
if Not_Null_Subtype then
Error_Msg
("null exclusion must apply to access type",
Not_Null_Subtype_Loc);
end if;
end if;
if Token = Tok_Procedure then
if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83) access to procedure not allowed!");
@ -4317,9 +4333,10 @@ package body Ch3 is
Set_Result_Definition (Type_Def_Node, Result_Node);
-- Access-to-object case
else
Type_Def_Node :=
New_Node (N_Access_To_Object_Definition, Access_Loc);
Type_Def_Node := New_Node (N_Access_To_Object_Definition, Access_Loc);
Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
Set_Null_Excluding_Subtype (Type_Def_Node, Not_Null_Subtype);