File : par-ch8.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . C H 8 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
29
30 separate (Par)
31 package body Ch8 is
32
33 -----------------------
34 -- Local Subprograms --
35 -----------------------
36
37 function P_Use_Package_Clause return Node_Id;
38 function P_Use_Type_Clause return Node_Id;
39
40 ---------------------
41 -- 8.4 Use Clause --
42 ---------------------
43
44 -- USE_CLAUSE ::= USE_PACKAGE_CLAUSE | USE_TYPE_CLAUSE
45
46 -- The caller has checked that the initial token is USE
47
48 -- Error recovery: cannot raise Error_Resync
49
50 function P_Use_Clause return Node_Id is
51 begin
52 Scan; -- past USE
53
54 if Token = Tok_Type or else Token = Tok_All then
55 return P_Use_Type_Clause;
56 else
57 return P_Use_Package_Clause;
58 end if;
59 end P_Use_Clause;
60
61 -----------------------------
62 -- 8.4 Use Package Clause --
63 -----------------------------
64
65 -- USE_PACKAGE_CLAUSE ::= use package_NAME {, package_NAME};
66
67 -- The caller has scanned out the USE keyword
68
69 -- Error recovery: cannot raise Error_Resync
70
71 function P_Use_Package_Clause return Node_Id is
72 Use_Node : Node_Id;
73
74 begin
75 Use_Node := New_Node (N_Use_Package_Clause, Prev_Token_Ptr);
76 Set_Names (Use_Node, New_List);
77
78 if Token = Tok_Package then
79 Error_Msg_SC ("PACKAGE should not appear here");
80 Scan; -- past PACKAGE
81 end if;
82
83 loop
84 Append (P_Qualified_Simple_Name, Names (Use_Node));
85 exit when Token /= Tok_Comma;
86 Scan; -- past comma
87 end loop;
88
89 TF_Semicolon;
90 return Use_Node;
91 end P_Use_Package_Clause;
92
93 --------------------------
94 -- 8.4 Use Type Clause --
95 --------------------------
96
97 -- USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK};
98
99 -- The caller has checked that the initial token is USE, scanned it out
100 -- and that the current token is either ALL or TYPE.
101
102 -- Note: Use of ALL is an Ada 2012 feature
103
104 -- Error recovery: cannot raise Error_Resync
105
106 function P_Use_Type_Clause return Node_Id is
107 Use_Node : Node_Id;
108 All_Present : Boolean;
109 Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;
110
111 begin
112 if Token = Tok_All then
113 Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
114 All_Present := True;
115 Scan; -- past ALL
116
117 if Token /= Tok_Type then
118 Error_Msg_SC ("TYPE expected");
119 end if;
120
121 else pragma Assert (Token = Tok_Type);
122 All_Present := False;
123 end if;
124
125 Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc);
126 Set_All_Present (Use_Node, All_Present);
127 Set_Subtype_Marks (Use_Node, New_List);
128 Set_Used_Operations (Use_Node, No_Elist);
129
130 if Ada_Version = Ada_83 then
131 Error_Msg_SC ("(Ada 83) use type not allowed!");
132 end if;
133
134 Scan; -- past TYPE
135
136 loop
137 Append (P_Subtype_Mark, Subtype_Marks (Use_Node));
138 No_Constraint;
139 exit when Token /= Tok_Comma;
140 Scan; -- past comma
141 end loop;
142
143 TF_Semicolon;
144 return Use_Node;
145 end P_Use_Type_Clause;
146
147 -------------------------------
148 -- 8.5 Renaming Declaration --
149 -------------------------------
150
151 -- Object renaming declarations and exception renaming declarations
152 -- are parsed by P_Identifier_Declaration (3.3.1)
153
154 -- Subprogram renaming declarations are parsed by P_Subprogram (6.1)
155
156 -- Package renaming declarations are parsed by P_Package (7.1)
157
158 -- Generic renaming declarations are parsed by P_Generic (12.1)
159
160 ----------------------------------------
161 -- 8.5.1 Object Renaming Declaration --
162 ----------------------------------------
163
164 -- Parsed by P_Identifier_Declarations (3.3.1)
165
166 ----------------------------------------
167 -- 8.5.2 Exception Renaming Declaration --
168 ----------------------------------------
169
170 -- Parsed by P_Identifier_Declarations (3.3.1)
171
172 -----------------------------------------
173 -- 8.5.3 Package Renaming Declaration --
174 -----------------------------------------
175
176 -- Parsed by P_Package (7.1)
177
178 --------------------------------------------
179 -- 8.5.4 Subprogram Renaming Declaration --
180 --------------------------------------------
181
182 -- Parsed by P_Subprogram (6.1)
183
184 -----------------------------------------
185 -- 8.5.2 Generic Renaming Declaration --
186 -----------------------------------------
187
188 -- Parsed by P_Generic (12.1)
189
190 end Ch8;