diff options
| -rw-r--r-- | gcc/ada/par-ch3.adb | 118 | ||||
| -rw-r--r-- | gcc/ada/par-ch6.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/par-endh.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/scans.ads | 6 |
4 files changed, 91 insertions, 60 deletions
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 8e8ac2a..b284b30 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -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; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index d8f7fda..903cc4e 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -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 diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index a6d5297..92f7e9b 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -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 diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index 694a603..a01b957 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -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 |