Commit 6c929a2e by Robert Dewar Committed by Arnaud Charlet

par-ch3.adb: (P_Type_Declaration): Set Type_Token_Location

2007-04-06  Robert Dewar  <dewar@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* par-ch3.adb: (P_Type_Declaration): Set Type_Token_Location
	(P_Interface_Type_Definition): Remove the formal Is_Synchronized because
	there is no need to generate always a record_definition_node in case
	of synchronized interface types.
	(P_Type_Declaration): Update calls to P_Interface_Type_Definition.
	(P_Null_Exclusion): For AI-447: Remove warnings about "not null" being
	illegal in Ada 95, in cases where it is legal. Change the warnings to
	errors in other cases. Don't give the error unless the "not null"
	parses properly. Correct the source position at which the error occurs.
	(P_Known_Discriminant_Part_Opt): Pass Allow_Anonymous_In_95 => True to
	P_Null_Exclusion, to suppress "not null" warnings.
	(P_Identifier_Declarations): Code cleanup. Removed unrequired label and
	associated goto statements.

	* par-endh.adb (Pop_End_Context): Allow more flexibility in placement
	of END RECORD

	* scans.ads (Type_Token_Location): New flag

	* par-ch6.adb (P_Mode): Check specifically for case of IN ACCESS
	(P_Formal_Part): Pass Allow_Anonymous_In_95 => True to
	P_Null_Exclusion, to suppress "not null" warnings.

From-SVN: r123587
parent 3726d5d9
...@@ -286,6 +286,7 @@ package body Ch3 is ...@@ -286,6 +286,7 @@ package body Ch3 is
-- If we have TYPE, then proceed ahead and scan identifier -- If we have TYPE, then proceed ahead and scan identifier
if Token = Tok_Type then if Token = Tok_Type then
Type_Token_Location := Type_Loc;
Scan; -- past TYPE Scan; -- past TYPE
Ident_Node := P_Defining_Identifier (C_Is); Ident_Node := P_Defining_Identifier (C_Is);
...@@ -634,9 +635,8 @@ package body Ch3 is ...@@ -634,9 +635,8 @@ package body Ch3 is
or else (Token = Tok_Identifier or else (Token = Tok_Identifier
and then Chars (Token_Node) = Name_Interface) and then Chars (Token_Node) = Name_Interface)
then then
Typedef_Node := P_Interface_Type_Definition Typedef_Node :=
(Abstract_Present, P_Interface_Type_Definition (Abstract_Present);
Is_Synchronized => False);
Abstract_Present := True; Abstract_Present := True;
Set_Limited_Present (Typedef_Node); Set_Limited_Present (Typedef_Node);
...@@ -721,8 +721,7 @@ package body Ch3 is ...@@ -721,8 +721,7 @@ package body Ch3 is
-- Ada 2005 (AI-251): INTERFACE -- Ada 2005 (AI-251): INTERFACE
when Tok_Interface => when Tok_Interface =>
Typedef_Node := P_Interface_Type_Definition Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
(Abstract_Present, Is_Synchronized => False);
Abstract_Present := True; Abstract_Present := True;
TF_Semicolon; TF_Semicolon;
exit; exit;
...@@ -761,8 +760,7 @@ package body Ch3 is ...@@ -761,8 +760,7 @@ package body Ch3 is
else else
Typedef_Node := Typedef_Node :=
P_Interface_Type_Definition P_Interface_Type_Definition (Abstract_Present);
(Abstract_Present, Is_Synchronized => True);
Abstract_Present := True; Abstract_Present := True;
case Saved_Token is case Saved_Token is
...@@ -925,25 +923,44 @@ package body Ch3 is ...@@ -925,25 +923,44 @@ package body Ch3 is
-- Error recovery: can raise Error_Resync -- Error recovery: can raise Error_Resync
function P_Null_Exclusion return Boolean is function P_Null_Exclusion
(Allow_Anonymous_In_95 : Boolean := False) return Boolean
is
Not_Loc : constant Source_Ptr := Token_Ptr;
-- Source position of "not", if present
begin begin
if Token /= Tok_Not then if Token /= Tok_Not then
return False; return False;
else else
-- Ada 2005 (AI-441): The qualifier has no semantic meaning in Ada 95
-- (all access Parameters Are "not null" in Ada 95).
if Ada_Version < Ada_05 then
Error_Msg_SP
("null-excluding access is an Ada 2005 extension?");
Error_Msg_SP ("\unit should be compiled with -gnat05 switch?");
end if;
Scan; -- past NOT Scan; -- past NOT
if Token = Tok_Null then if Token = Tok_Null then
Scan; -- past NULL Scan; -- past NULL
-- 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.
if Ada_Version >= Ada_05
or else (Ada_Version >= Ada_95
and then Allow_Anonymous_In_95
and then Token = Tok_Access)
then
null; -- OK
else
Error_Msg
("null-excluding access is an Ada 2005 extension", Not_Loc);
Error_Msg
("\unit should be compiled with -gnat05 switch", Not_Loc);
end if;
else else
Error_Msg_SP ("NULL expected"); Error_Msg_SP ("NULL expected");
end if; end if;
...@@ -953,8 +970,9 @@ package body Ch3 is ...@@ -953,8 +970,9 @@ package body Ch3 is
end P_Null_Exclusion; end P_Null_Exclusion;
function P_Subtype_Indication function P_Subtype_Indication
(Not_Null_Present : Boolean := False) return Node_Id is (Not_Null_Present : Boolean := False) return Node_Id
Type_Node : Node_Id; is
Type_Node : Node_Id;
begin begin
if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
...@@ -984,9 +1002,10 @@ package body Ch3 is ...@@ -984,9 +1002,10 @@ package body Ch3 is
function P_Subtype_Indication function P_Subtype_Indication
(Subtype_Mark : Node_Id; (Subtype_Mark : Node_Id;
Not_Null_Present : Boolean := False) return Node_Id is Not_Null_Present : Boolean := False) return Node_Id
Indic_Node : Node_Id; is
Constr_Node : Node_Id; Indic_Node : Node_Id;
Constr_Node : Node_Id;
begin begin
Constr_Node := P_Constraint_Opt; Constr_Node := P_Constraint_Opt;
...@@ -1019,7 +1038,6 @@ package body Ch3 is ...@@ -1019,7 +1038,6 @@ package body Ch3 is
function P_Subtype_Mark return Node_Id is function P_Subtype_Mark return Node_Id is
begin begin
return P_Subtype_Mark_Resync; return P_Subtype_Mark_Resync;
exception exception
when Error_Resync => when Error_Resync =>
return Error; return Error;
...@@ -1602,7 +1620,6 @@ package body Ch3 is ...@@ -1602,7 +1620,6 @@ package body Ch3 is
if Token /= Tok_Renames then if Token /= Tok_Renames then
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc); Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
Set_Object_Definition (Decl_Node, Acc_Node); Set_Object_Definition (Decl_Node, Acc_Node);
goto init;
else else
Scan; -- past renames Scan; -- past renames
...@@ -1675,7 +1692,6 @@ package body Ch3 is ...@@ -1675,7 +1692,6 @@ package body Ch3 is
if Token /= Tok_Renames then if Token /= Tok_Renames then
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc); Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
Set_Object_Definition (Decl_Node, Acc_Node); Set_Object_Definition (Decl_Node, Acc_Node);
goto init; -- ??? is this really needed goes here anyway
else else
Scan; -- past renames Scan; -- past renames
...@@ -1723,7 +1739,6 @@ package body Ch3 is ...@@ -1723,7 +1739,6 @@ package body Ch3 is
-- Scan out initialization, allowed only for object declaration -- Scan out initialization, allowed only for object declaration
<<init>> -- is this really needed ???
Init_Loc := Token_Ptr; Init_Loc := Token_Ptr;
Init_Expr := Init_Expr_Opt; Init_Expr := Init_Expr_Opt;
...@@ -2785,7 +2800,8 @@ package body Ch3 is ...@@ -2785,7 +2800,8 @@ package body Ch3 is
Specification_Node := Specification_Node :=
New_Node (N_Discriminant_Specification, Ident_Sloc); New_Node (N_Discriminant_Specification, Ident_Sloc);
Set_Defining_Identifier (Specification_Node, Idents (Ident)); Set_Defining_Identifier (Specification_Node, Idents (Ident));
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231) Not_Null_Present := -- Ada 2005 (AI-231, AI-447)
P_Null_Exclusion (Allow_Anonymous_In_95 => True);
if Token = Tok_Access then if Token = Tok_Access then
if Ada_Version = Ada_83 then if Ada_Version = Ada_83 then
...@@ -3566,8 +3582,7 @@ package body Ch3 is ...@@ -3566,8 +3582,7 @@ package body Ch3 is
-- Error recovery: cannot raise Error_Resync -- Error recovery: cannot raise Error_Resync
function P_Interface_Type_Definition function P_Interface_Type_Definition
(Abstract_Present : Boolean; (Abstract_Present : Boolean) return Node_Id
Is_Synchronized : Boolean) return Node_Id
is is
Typedef_Node : Node_Id; Typedef_Node : Node_Id;
...@@ -3584,13 +3599,10 @@ package body Ch3 is ...@@ -3584,13 +3599,10 @@ package body Ch3 is
Scan; -- past INTERFACE Scan; -- past INTERFACE
-- Ada 2005 (AI-345): In case of synchronized interfaces and -- Ada 2005 (AI-345): In case of interfaces with a null list of
-- interfaces with a null list of interfaces we build a -- interfaces we build a record_definition node.
-- record_definition node.
if Is_Synchronized if Token = Tok_Semicolon then
or else Token = Tok_Semicolon
then
Typedef_Node := New_Node (N_Record_Definition, Token_Ptr); Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
Set_Abstract_Present (Typedef_Node); Set_Abstract_Present (Typedef_Node);
...@@ -3598,20 +3610,6 @@ package body Ch3 is ...@@ -3598,20 +3610,6 @@ package body Ch3 is
Set_Null_Present (Typedef_Node); Set_Null_Present (Typedef_Node);
Set_Interface_Present (Typedef_Node); Set_Interface_Present (Typedef_Node);
if Is_Synchronized
and then Token = Tok_And
then
Scan; -- past AND
Set_Interface_List (Typedef_Node, New_List);
loop
Append (P_Qualified_Simple_Name,
Interface_List (Typedef_Node));
exit when Token /= Tok_And;
Scan; -- past AND
end loop;
end if;
-- Ada 2005 (AI-251): In case of not-synchronized interfaces that have -- Ada 2005 (AI-251): In case of not-synchronized interfaces that have
-- a list of interfaces we build a derived_type_definition node. This -- a list of interfaces we build a derived_type_definition node. This
-- simplifies the semantic analysis (and hence further mainteinance) -- simplifies the semantic analysis (and hence further mainteinance)
...@@ -3678,18 +3676,23 @@ package body Ch3 is ...@@ -3678,18 +3676,23 @@ package body Ch3 is
-- Error recovery: can raise Error_Resync -- Error recovery: can raise Error_Resync
function P_Access_Type_Definition function P_Access_Type_Definition
(Header_Already_Parsed : Boolean := False) return Node_Id is (Header_Already_Parsed : Boolean := False) return Node_Id
Access_Loc : constant Source_Ptr := Token_Ptr; is
Prot_Flag : Boolean; Access_Loc : constant Source_Ptr := Token_Ptr;
Not_Null_Present : Boolean := False; Prot_Flag : Boolean;
Type_Def_Node : Node_Id; Not_Null_Present : Boolean := False;
Result_Not_Null : Boolean; Type_Def_Node : Node_Id;
Result_Node : Node_Id; Result_Not_Null : Boolean;
Result_Node : Node_Id;
procedure Check_Junk_Subprogram_Name; procedure Check_Junk_Subprogram_Name;
-- Used in access to subprogram definition cases to check for an -- Used in access to subprogram definition cases to check for an
-- identifier or operator symbol that does not belong. -- identifier or operator symbol that does not belong.
--------------------------------
-- Check_Junk_Subprogram_Name --
--------------------------------
procedure Check_Junk_Subprogram_Name is procedure Check_Junk_Subprogram_Name is
Saved_State : Saved_Scan_State; Saved_State : Saved_Scan_State;
...@@ -3846,7 +3849,8 @@ package body Ch3 is ...@@ -3846,7 +3849,8 @@ package body Ch3 is
-- Error recovery: cannot raise Error_Resync -- Error recovery: cannot raise Error_Resync
function P_Access_Definition function P_Access_Definition
(Null_Exclusion_Present : Boolean) return Node_Id is (Null_Exclusion_Present : Boolean) return Node_Id
is
Def_Node : Node_Id; Def_Node : Node_Id;
Subp_Node : Node_Id; Subp_Node : Node_Id;
......
...@@ -1084,7 +1084,13 @@ package body Ch6 is ...@@ -1084,7 +1084,13 @@ package body Ch6 is
Specification_Node := Specification_Node :=
New_Node (N_Parameter_Specification, Ident_Sloc); New_Node (N_Parameter_Specification, Ident_Sloc);
Set_Defining_Identifier (Specification_Node, Idents (Ident)); Set_Defining_Identifier (Specification_Node, Idents (Ident));
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
-- Scan possible NOT NULL for Ada 2005 (AI-231, AI-447)
Not_Null_Present :=
P_Null_Exclusion (Allow_Anonymous_In_95 => True);
-- Case of ACCESS keyword present
if Token = Tok_Access then if Token = Tok_Access then
Set_Null_Exclusion_Present Set_Null_Exclusion_Present
...@@ -1094,8 +1100,11 @@ package body Ch6 is ...@@ -1094,8 +1100,11 @@ package body Ch6 is
Error_Msg_SC ("(Ada 83) access parameters not allowed"); Error_Msg_SC ("(Ada 83) access parameters not allowed");
end if; end if;
Set_Parameter_Type (Specification_Node, Set_Parameter_Type
P_Access_Definition (Not_Null_Present)); (Specification_Node,
P_Access_Definition (Not_Null_Present));
-- Case of IN or OUT present
else else
if Token = Tok_In or else Token = Tok_Out then if Token = Tok_In or else Token = Tok_Out then
...@@ -1237,6 +1246,11 @@ package body Ch6 is ...@@ -1237,6 +1246,11 @@ package body Ch6 is
if Style.Mode_In_Check and then Token /= Tok_Out then if Style.Mode_In_Check and then Token /= Tok_Out then
Error_Msg_SP ("(style) IN should be omitted"); Error_Msg_SP ("(style) IN should be omitted");
end if; end if;
if Token = Tok_Access then
Error_Msg_SP ("IN not allowed together with ACCESS");
Scan; -- past ACCESS
end if;
end if; end if;
if Token = Tok_Out then if Token = Tok_Out then
......
...@@ -1042,6 +1042,13 @@ package body Endh is ...@@ -1042,6 +1042,13 @@ package body Endh is
if Style.RM_Column_Check then if Style.RM_Column_Check then
if End_Column /= Scope.Table (Scope.Last).Ecol if End_Column /= Scope.Table (Scope.Last).Ecol
and then Current_Line_Start > Scope.Table (Scope.Last).Sloc and then Current_Line_Start > Scope.Table (Scope.Last).Sloc
-- A special case, for END RECORD, we are also allowed to
-- line up with the TYPE keyword opening the declaration.
and then (Scope.Table (Scope.Last).Etyp /= E_Record
or else Get_Column_Number (End_Sloc) /=
Get_Column_Number (Type_Token_Location))
then then
Error_Msg_Col := Scope.Table (Scope.Last).Ecol; Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
Error_Msg Error_Msg
......
...@@ -365,6 +365,12 @@ package Scans is ...@@ -365,6 +365,12 @@ package Scans is
-- on the line containing the current token. This is used for error -- on the line containing the current token. This is used for error
-- recovery circuits which depend on looking at the column line up. -- recovery circuits which depend on looking at the column line up.
Type_Token_Location : Source_Ptr;
-- Within a type declaration, gives the location of the TYPE keyword that
-- opened the type declaration. Used in checking the end column of a record
-- declaration, which can line up either with the TYPE keyword, or with the
-- start of the line containing the RECORD keyword.
Checksum : Word; Checksum : Word;
-- Used to accumulate a CRC representing the tokens in the source -- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and -- file being compiled. This CRC includes only program tokens, and
......
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