OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Robert Dewar 2007-04-06 11:24:49 +02:00 committed by Arnaud Charlet
parent 3726d5d99a
commit 6c929a2ea0
4 changed files with 91 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
gcc/ada/par-ch3.adb
View File

@ -286,6 +286,7 @@ package body Ch3 is
-- If we have TYPE, then proceed ahead and scan identifier
if Token = Tok_Type then
Type_Token_Location := Type_Loc;
Scan; -- past TYPE
Ident_Node := P_Defining_Identifier (C_Is);
@ -634,9 +635,8 @@ package body Ch3 is
or else (Token = Tok_Identifier
and then Chars (Token_Node) = Name_Interface)
then
Typedef_Node := P_Interface_Type_Definition
(Abstract_Present,
Is_Synchronized => False);
Typedef_Node :=
P_Interface_Type_Definition (Abstract_Present);
Abstract_Present := True;
Set_Limited_Present (Typedef_Node);
@ -721,8 +721,7 @@ package body Ch3 is
-- Ada 2005 (AI-251): INTERFACE
when Tok_Interface =>
Typedef_Node := P_Interface_Type_Definition
(Abstract_Present, Is_Synchronized => False);
Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
Abstract_Present := True;
TF_Semicolon;
exit;
@ -761,8 +760,7 @@ package body Ch3 is
else
Typedef_Node :=
P_Interface_Type_Definition
(Abstract_Present, Is_Synchronized => True);
P_Interface_Type_Definition (Abstract_Present);
Abstract_Present := True;
case Saved_Token is
@ -925,25 +923,44 @@ package body Ch3 is
-- 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
if Token /= Tok_Not then
return False;
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
if Token = Tok_Null then
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
Error_Msg_SP ("NULL expected");
end if;
@ -953,8 +970,9 @@ package body Ch3 is
end P_Null_Exclusion;
function P_Subtype_Indication
(Not_Null_Present : Boolean := False) return Node_Id is
Type_Node : Node_Id;
(Not_Null_Present : Boolean := False) return Node_Id
is
Type_Node : Node_Id;
begin
if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
@ -984,9 +1002,10 @@ package body Ch3 is
function P_Subtype_Indication
(Subtype_Mark : Node_Id;
Not_Null_Present : Boolean := False) return Node_Id is
Indic_Node : Node_Id;
Constr_Node : Node_Id;
Not_Null_Present : Boolean := False) return Node_Id
is
Indic_Node : Node_Id;
Constr_Node : Node_Id;
begin
Constr_Node := P_Constraint_Opt;
@ -1019,7 +1038,6 @@ package body Ch3 is
function P_Subtype_Mark return Node_Id is
begin
return P_Subtype_Mark_Resync;
exception
when Error_Resync =>
return Error;
@ -1602,7 +1620,6 @@ package body Ch3 is
if Token /= Tok_Renames then
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
Set_Object_Definition (Decl_Node, Acc_Node);
goto init;
else
Scan; -- past renames
@ -1675,7 +1692,6 @@ package body Ch3 is
if Token /= Tok_Renames then
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
Set_Object_Definition (Decl_Node, Acc_Node);
goto init; -- ??? is this really needed goes here anyway
else
Scan; -- past renames
@ -1723,7 +1739,6 @@ package body Ch3 is
-- Scan out initialization, allowed only for object declaration
<<init>> -- is this really needed ???
Init_Loc := Token_Ptr;
Init_Expr := Init_Expr_Opt;
@ -2785,7 +2800,8 @@ package body Ch3 is
Specification_Node :=
New_Node (N_Discriminant_Specification, Ident_Sloc);
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 Ada_Version = Ada_83 then
@ -3566,8 +3582,7 @@ package body Ch3 is
-- Error recovery: cannot raise Error_Resync
function P_Interface_Type_Definition
(Abstract_Present : Boolean;
Is_Synchronized : Boolean) return Node_Id
(Abstract_Present : Boolean) return Node_Id
is
Typedef_Node : Node_Id;
@ -3584,13 +3599,10 @@ package body Ch3 is
Scan; -- past INTERFACE
-- Ada 2005 (AI-345): In case of synchronized interfaces and
-- interfaces with a null list of interfaces we build a
-- record_definition node.
-- Ada 2005 (AI-345): In case of interfaces with a null list of
-- interfaces we build a record_definition node.
if Is_Synchronized
or else Token = Tok_Semicolon
then
if Token = Tok_Semicolon then
Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
Set_Abstract_Present (Typedef_Node);
@ -3598,20 +3610,6 @@ package body Ch3 is
Set_Null_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
-- a list of interfaces we build a derived_type_definition node. This
-- simplifies the semantic analysis (and hence further mainteinance)
@ -3678,18 +3676,23 @@ package body Ch3 is
-- Error recovery: can raise Error_Resync
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;
Type_Def_Node : Node_Id;
Result_Not_Null : Boolean;
Result_Node : Node_Id;
(Header_Already_Parsed : Boolean := False) return Node_Id
is
Access_Loc : constant Source_Ptr := Token_Ptr;
Prot_Flag : Boolean;
Not_Null_Present : 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.
--------------------------------
-- Check_Junk_Subprogram_Name --
--------------------------------
procedure Check_Junk_Subprogram_Name is
Saved_State : Saved_Scan_State;
@ -3846,7 +3849,8 @@ package body Ch3 is
-- Error recovery: cannot raise Error_Resync
function P_Access_Definition
(Null_Exclusion_Present : Boolean) return Node_Id is
(Null_Exclusion_Present : Boolean) return Node_Id
is
Def_Node : Node_Id;
Subp_Node : Node_Id;

20
gcc/ada/par-ch6.adb
View File

@ -1084,7 +1084,13 @@ package body Ch6 is
Specification_Node :=
New_Node (N_Parameter_Specification, Ident_Sloc);
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
Set_Null_Exclusion_Present
@ -1094,8 +1100,11 @@ package body Ch6 is
Error_Msg_SC ("(Ada 83) access parameters not allowed");
end if;
Set_Parameter_Type (Specification_Node,
P_Access_Definition (Not_Null_Present));
Set_Parameter_Type
(Specification_Node,
P_Access_Definition (Not_Null_Present));
-- Case of IN or OUT present
else
if Token = Tok_In or else Token = Tok_Out then
@ -1237,6 +1246,11 @@ package body Ch6 is
if Style.Mode_In_Check and then Token /= Tok_Out then
Error_Msg_SP ("(style) IN should be omitted");
end if;
if Token = Tok_Access then
Error_Msg_SP ("IN not allowed together with ACCESS");
Scan; -- past ACCESS
end if;
end if;
if Token = Tok_Out then

7
gcc/ada/par-endh.adb
View File

@ -1042,6 +1042,13 @@ package body Endh is
if Style.RM_Column_Check then
if End_Column /= Scope.Table (Scope.Last).Ecol
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
Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
Error_Msg

6
gcc/ada/scans.ads
View File

@ -365,6 +365,12 @@ package Scans is
-- on the line containing the current token. This is used for error
-- 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;
-- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and