diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/par-ch7.adb')
| -rw-r--r-- | gcc-4.8/gcc/ada/par-ch7.adb | 361 |
1 files changed, 0 insertions, 361 deletions
diff --git a/gcc-4.8/gcc/ada/par-ch7.adb b/gcc-4.8/gcc/ada/par-ch7.adb deleted file mode 100644 index 15f98bfcf..000000000 --- a/gcc-4.8/gcc/ada/par-ch7.adb +++ /dev/null @@ -1,361 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P A R . C H 7 -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2011, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -pragma Style_Checks (All_Checks); --- Turn off subprogram body ordering check. Subprograms are in order --- by RM section rather than alphabetical - -separate (Par) -package body Ch7 is - - --------------------------------------------- - -- 7.1 Package (also 8.5.3, 10.1.3, 12.3) -- - --------------------------------------------- - - -- This routine scans out a package declaration, package body, or a - -- renaming declaration or generic instantiation starting with PACKAGE - - -- PACKAGE_DECLARATION ::= - -- PACKAGE_SPECIFICATION - -- [ASPECT_SPECIFICATIONS]; - - -- PACKAGE_SPECIFICATION ::= - -- package DEFINING_PROGRAM_UNIT_NAME is - -- {BASIC_DECLARATIVE_ITEM} - -- [private - -- {BASIC_DECLARATIVE_ITEM}] - -- end [[PARENT_UNIT_NAME .] IDENTIFIER] - - -- PACKAGE_BODY ::= - -- package body DEFINING_PROGRAM_UNIT_NAME is - -- DECLARATIVE_PART - -- [begin - -- HANDLED_SEQUENCE_OF_STATEMENTS] - -- end [[PARENT_UNIT_NAME .] IDENTIFIER] - - -- PACKAGE_RENAMING_DECLARATION ::= - -- package DEFINING_IDENTIFIER renames package_NAME; - - -- PACKAGE_BODY_STUB ::= - -- package body DEFINING_IDENTIFIER is separate; - - -- PACKAGE_INSTANTIATION ::= - -- package DEFINING_PROGRAM_UNIT_NAME is - -- new generic_package_NAME [GENERIC_ACTUAL_PART] - -- [ASPECT_SPECIFICATIONS]; - - -- The value in Pf_Flags indicates which of these possible declarations - -- is acceptable to the caller: - - -- Pf_Flags.Spcn Set if specification OK - -- Pf_Flags.Decl Set if declaration OK - -- Pf_Flags.Gins Set if generic instantiation OK - -- Pf_Flags.Pbod Set if proper body OK - -- Pf_Flags.Rnam Set if renaming declaration OK - -- Pf_Flags.Stub Set if body stub OK - - -- If an inappropriate form is encountered, it is scanned out but an error - -- message indicating that it is appearing in an inappropriate context is - -- issued. The only possible settings for Pf_Flags are those defined as - -- constants in package Par. - - -- Note: in all contexts where a package specification is required, there - -- is a terminating semicolon. This semicolon is scanned out in the case - -- where Pf_Flags is set to Pf_Spcn, even though it is not strictly part - -- of the package specification (it's just too much trouble, and really - -- quite unnecessary, to deal with scanning out an END where the semicolon - -- after the END is not considered to be part of the END. - - -- The caller has checked that the initial token is PACKAGE - - -- Error recovery: cannot raise Error_Resync - - function P_Package (Pf_Flags : Pf_Rec) return Node_Id is - Package_Node : Node_Id; - Specification_Node : Node_Id; - Name_Node : Node_Id; - Package_Sloc : Source_Ptr; - - Aspect_Sloc : Source_Ptr := No_Location; - -- Save location of WITH for scanned aspects. Left set to No_Location - -- if no aspects scanned before the IS keyword. - - Is_Sloc : Source_Ptr; - -- Save location of IS token for package declaration - - Dummy_Node : constant Node_Id := - New_Node (N_Package_Specification, Token_Ptr); - -- Dummy node to attach aspect specifications to until we properly - -- figure out where they eventually belong. - - Body_Is_Hidden_In_SPARK : Boolean; - Private_Part_Is_Hidden_In_SPARK : Boolean; - Hidden_Region_Start : Source_Ptr; - - begin - Push_Scope_Stack; - Scope.Table (Scope.Last).Etyp := E_Name; - Scope.Table (Scope.Last).Ecol := Start_Column; - Scope.Table (Scope.Last).Lreq := False; - - Package_Sloc := Token_Ptr; - Scan; -- past PACKAGE - - if Token = Tok_Type then - Error_Msg_SC -- CODEFIX - ("TYPE not allowed here"); - Scan; -- past TYPE - end if; - - -- Case of package body. Note that we demand a package body if that - -- is the only possibility (even if the BODY keyword is not present) - - if Token = Tok_Body or else Pf_Flags = Pf_Pbod_Pexp then - if not Pf_Flags.Pbod then - Error_Msg_SC ("package body cannot appear here!"); - end if; - - T_Body; - Name_Node := P_Defining_Program_Unit_Name; - Scope.Table (Scope.Last).Labl := Name_Node; - TF_Is; - - if Separate_Present then - if not Pf_Flags.Stub then - Error_Msg_SC ("body stub cannot appear here!"); - end if; - - Scan; -- past SEPARATE - TF_Semicolon; - Pop_Scope_Stack; - - Package_Node := New_Node (N_Package_Body_Stub, Package_Sloc); - Set_Defining_Identifier (Package_Node, Name_Node); - - else - Package_Node := New_Node (N_Package_Body, Package_Sloc); - Set_Defining_Unit_Name (Package_Node, Name_Node); - - -- In SPARK, a HIDE directive can be placed at the beginning of a - -- package implementation, thus hiding the package body from SPARK - -- tool-set. No violation of the SPARK restriction should be - -- issued on nodes in a hidden part, which is obtained by marking - -- such hidden parts. - - if Token = Tok_SPARK_Hide then - Body_Is_Hidden_In_SPARK := True; - Hidden_Region_Start := Token_Ptr; - Scan; -- past HIDE directive - else - Body_Is_Hidden_In_SPARK := False; - end if; - - Parse_Decls_Begin_End (Package_Node); - - if Body_Is_Hidden_In_SPARK then - Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); - end if; - end if; - - -- Cases other than Package_Body - - else - Name_Node := P_Defining_Program_Unit_Name; - Scope.Table (Scope.Last).Labl := Name_Node; - - -- Case of renaming declaration - - Check_Misspelling_Of (Tok_Renames); - - if Token = Tok_Renames then - if not Pf_Flags.Rnam then - Error_Msg_SC ("renaming declaration cannot appear here!"); - end if; - - Scan; -- past RENAMES; - - Package_Node := - New_Node (N_Package_Renaming_Declaration, Package_Sloc); - Set_Defining_Unit_Name (Package_Node, Name_Node); - Set_Name (Package_Node, P_Qualified_Simple_Name); - - No_Constraint; - TF_Semicolon; - Pop_Scope_Stack; - - -- Generic package instantiation or package declaration - - else - if Aspect_Specifications_Present then - Aspect_Sloc := Token_Ptr; - P_Aspect_Specifications (Dummy_Node, Semicolon => False); - end if; - - Is_Sloc := Token_Ptr; - TF_Is; - - -- Case of generic instantiation - - if Token = Tok_New then - if not Pf_Flags.Gins then - Error_Msg_SC - ("generic instantiation cannot appear here!"); - end if; - - if Aspect_Sloc /= No_Location then - Error_Msg - ("misplaced aspects for package instantiation", - Aspect_Sloc); - end if; - - Scan; -- past NEW - - Package_Node := - New_Node (N_Package_Instantiation, Package_Sloc); - Set_Defining_Unit_Name (Package_Node, Name_Node); - Set_Name (Package_Node, P_Qualified_Simple_Name); - Set_Generic_Associations - (Package_Node, P_Generic_Actual_Part_Opt); - - if Aspect_Sloc /= No_Location - and then not Aspect_Specifications_Present - then - Error_Msg_SC ("\info: aspect specifications belong here"); - Move_Aspects (From => Dummy_Node, To => Package_Node); - end if; - - P_Aspect_Specifications (Package_Node); - Pop_Scope_Stack; - - -- Case of package declaration or package specification - - else - Specification_Node := - New_Node (N_Package_Specification, Package_Sloc); - - Set_Defining_Unit_Name (Specification_Node, Name_Node); - Set_Visible_Declarations - (Specification_Node, P_Basic_Declarative_Items); - - if Token = Tok_Private then - Error_Msg_Col := Scope.Table (Scope.Last).Ecol; - - if RM_Column_Check then - if Token_Is_At_Start_Of_Line - and then Start_Column /= Error_Msg_Col - then - Error_Msg_SC - ("(style) PRIVATE in wrong column, should be@"); - end if; - end if; - - Scan; -- past PRIVATE - - if Token = Tok_SPARK_Hide then - Private_Part_Is_Hidden_In_SPARK := True; - Hidden_Region_Start := Token_Ptr; - Scan; -- past HIDE directive - else - Private_Part_Is_Hidden_In_SPARK := False; - end if; - - Set_Private_Declarations - (Specification_Node, P_Basic_Declarative_Items); - - -- In SPARK, a HIDE directive can be placed at the beginning - -- of a private part, thus hiding all declarations in the - -- private part from SPARK tool-set. No violation of the - -- SPARK restriction should be issued on nodes in a hidden - -- part, which is obtained by marking such hidden parts. - - if Private_Part_Is_Hidden_In_SPARK then - Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); - end if; - - -- Deal gracefully with multiple PRIVATE parts - - while Token = Tok_Private loop - Error_Msg_SC - ("only one private part allowed per package"); - Scan; -- past PRIVATE - Append_List (P_Basic_Declarative_Items, - Private_Declarations (Specification_Node)); - end loop; - end if; - - if Pf_Flags = Pf_Spcn then - Package_Node := Specification_Node; - else - Package_Node := - New_Node (N_Package_Declaration, Package_Sloc); - Set_Specification (Package_Node, Specification_Node); - end if; - - if Token = Tok_Begin then - Error_Msg_SC ("begin block not allowed in package spec"); - Scan; -- past BEGIN - Discard_Junk_List (P_Sequence_Of_Statements (SS_None)); - end if; - - End_Statements (Specification_Node, Empty, Is_Sloc); - Move_Aspects (From => Dummy_Node, To => Package_Node); - end if; - end if; - end if; - - return Package_Node; - end P_Package; - - ------------------------------ - -- 7.1 Package Declaration -- - ------------------------------ - - -- Parsed by P_Package (7.1) - - -------------------------------- - -- 7.1 Package Specification -- - -------------------------------- - - -- Parsed by P_Package (7.1) - - ----------------------- - -- 7.1 Package Body -- - ----------------------- - - -- Parsed by P_Package (7.1) - - ----------------------------------- - -- 7.3 Private Type Declaration -- - ----------------------------------- - - -- Parsed by P_Type_Declaration (3.2.1) - - ---------------------------------------- - -- 7.3 Private Extension Declaration -- - ---------------------------------------- - - -- Parsed by P_Type_Declaration (3.2.1) - -end Ch7; |