1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 pragma Style_Checks (All_Checks);
29 -- Turn off subprogram body ordering check. Subprograms are in order
30 -- by RM section rather than alphabetical
35 ---------------------------------------------
36 -- 7.1 Package (also 8.5.3, 10.1.3, 12.3) --
37 ---------------------------------------------
39 -- This routine scans out a package declaration, package body, or a
40 -- renaming declaration or generic instantiation starting with PACKAGE
42 -- PACKAGE_DECLARATION ::= PACKAGE_SPECIFICATION;
44 -- PACKAGE_SPECIFICATION ::=
45 -- package DEFINING_PROGRAM_UNIT_NAME is
46 -- {BASIC_DECLARATIVE_ITEM}
48 -- {BASIC_DECLARATIVE_ITEM}]
49 -- end [[PARENT_UNIT_NAME .] IDENTIFIER]
52 -- package body DEFINING_PROGRAM_UNIT_NAME is
55 -- HANDLED_SEQUENCE_OF_STATEMENTS]
56 -- end [[PARENT_UNIT_NAME .] IDENTIFIER]
58 -- PACKAGE_RENAMING_DECLARATION ::=
59 -- package DEFINING_IDENTIFIER renames package_NAME;
61 -- PACKAGE_BODY_STUB ::=
62 -- package body DEFINING_IDENTIFIER is separate;
64 -- The value in Pf_Flags indicates which of these possible declarations
65 -- is acceptable to the caller:
67 -- Pf_Flags.Spcn Set if specification OK
68 -- Pf_Flags.Decl Set if declaration OK
69 -- Pf_Flags.Gins Set if generic instantiation OK
70 -- Pf_Flags.Pbod Set if proper body OK
71 -- Pf_Flags.Rnam Set if renaming declaration OK
72 -- Pf_Flags.Stub Set if body stub OK
74 -- If an inappropriate form is encountered, it is scanned out but an
75 -- error message indicating that it is appearing in an inappropriate
76 -- context is issued. The only possible settings for Pf_Flags are those
77 -- defined as constants in package Par.
79 -- Note: in all contexts where a package specification is required, there
80 -- is a terminating semicolon. This semicolon is scanned out in the case
81 -- where Pf_Flags is set to Pf_Spcn, even though it is not strictly part
82 -- of the package specification (it's just too much trouble, and really
83 -- quite unnecessary, to deal with scanning out an END where the semicolon
84 -- after the END is not considered to be part of the END.
86 -- The caller has checked that the initial token is PACKAGE
88 -- Error recovery: cannot raise Error_Resync
90 function P_Package (Pf_Flags : Pf_Rec) return Node_Id is
91 Package_Node : Node_Id;
92 Specification_Node : Node_Id;
94 Package_Sloc : Source_Ptr;
98 Scope.Table (Scope.Last).Etyp := E_Name;
99 Scope.Table (Scope.Last).Ecol := Start_Column;
100 Scope.Table (Scope.Last).Lreq := False;
102 Package_Sloc := Token_Ptr;
103 Scan; -- past PACKAGE
105 if Token = Tok_Type then
106 Error_Msg_SC ("TYPE not allowed here");
110 -- Case of package body. Note that we demand a package body if that
111 -- is the only possibility (even if the BODY keyword is not present)
113 if Token = Tok_Body or else Pf_Flags = Pf_Pbod then
114 if not Pf_Flags.Pbod then
115 Error_Msg_SC ("package body cannot appear here!");
119 Name_Node := P_Defining_Program_Unit_Name;
120 Scope.Table (Scope.Last).Labl := Name_Node;
123 if Separate_Present then
124 if not Pf_Flags.Stub then
125 Error_Msg_SC ("body stub cannot appear here!");
128 Scan; -- past SEPARATE
132 Package_Node := New_Node (N_Package_Body_Stub, Package_Sloc);
133 Set_Defining_Identifier (Package_Node, Name_Node);
136 Package_Node := New_Node (N_Package_Body, Package_Sloc);
137 Set_Defining_Unit_Name (Package_Node, Name_Node);
138 Parse_Decls_Begin_End (Package_Node);
143 -- Cases other than Package_Body
146 Name_Node := P_Defining_Program_Unit_Name;
147 Scope.Table (Scope.Last).Labl := Name_Node;
149 -- Case of renaming declaration
151 Check_Misspelling_Of (Tok_Renames);
153 if Token = Tok_Renames then
154 if not Pf_Flags.Rnam then
155 Error_Msg_SC ("renaming declaration cannot appear here!");
158 Scan; -- past RENAMES;
161 New_Node (N_Package_Renaming_Declaration, Package_Sloc);
162 Set_Defining_Unit_Name (Package_Node, Name_Node);
163 Set_Name (Package_Node, P_Qualified_Simple_Name);
173 -- Case of generic instantiation
175 if Token = Tok_New then
176 if not Pf_Flags.Gins then
178 ("generic instantiation cannot appear here!");
184 New_Node (N_Package_Instantiation, Package_Sloc);
185 Set_Defining_Unit_Name (Package_Node, Name_Node);
186 Set_Name (Package_Node, P_Qualified_Simple_Name);
187 Set_Generic_Associations
188 (Package_Node, P_Generic_Actual_Part_Opt);
192 -- Case of package declaration or package specification
195 Specification_Node :=
196 New_Node (N_Package_Specification, Package_Sloc);
198 Set_Defining_Unit_Name (Specification_Node, Name_Node);
199 Set_Visible_Declarations
200 (Specification_Node, P_Basic_Declarative_Items);
202 if Token = Tok_Private then
203 Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
205 if Style.RM_Column_Check then
206 if Token_Is_At_Start_Of_Line
207 and then Start_Column /= Error_Msg_Col
210 ("(style) PRIVATE in wrong column, should be@");
214 Scan; -- past PRIVATE
215 Set_Private_Declarations
216 (Specification_Node, P_Basic_Declarative_Items);
218 -- Deal gracefully with multiple PRIVATE parts
220 while Token = Tok_Private loop
222 ("only one private part allowed per package");
223 Scan; -- past PRIVATE
224 Append_List (P_Basic_Declarative_Items,
225 Private_Declarations (Specification_Node));
229 if Pf_Flags = Pf_Spcn then
230 Package_Node := Specification_Node;
233 New_Node (N_Package_Declaration, Package_Sloc);
234 Set_Specification (Package_Node, Specification_Node);
237 if Token = Tok_Begin then
238 Error_Msg_SC ("begin block not allowed in package spec");
240 Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
243 End_Statements (Specification_Node);
251 ------------------------------
252 -- 7.1 Package Declaration --
253 ------------------------------
255 -- Parsed by P_Package (7.1)
257 --------------------------------
258 -- 7.1 Package Specification --
259 --------------------------------
261 -- Parsed by P_Package (7.1)
263 -----------------------
264 -- 7.1 Package Body --
265 -----------------------
267 -- Parsed by P_Package (7.1)
269 -----------------------------------
270 -- 7.3 Private Type Declaration --
271 -----------------------------------
273 -- Parsed by P_Type_Declaration (3.2.1)
275 ----------------------------------------
276 -- 7.3 Private Extension Declaration --
277 ----------------------------------------
279 -- Parsed by P_Type_Declaration (3.2.1)