|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P A R . C H 8 --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
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 procedure Append_Use_Clause
|
|
|
38 (Item_List : List_Id;
|
|
|
39 Use_Node : Node_Id;
|
|
|
40 Is_First : in out Boolean;
|
|
|
41 Is_Last : in out Boolean);
|
|
|
42 -- Append a use_clause to the Item_List, appropriately setting the Prev_Ids
|
|
|
43 -- and More_Ids flags for each split use node. The flags Is_First and
|
|
|
44 -- Is_Last track position of subtype_marks or names within the original
|
|
|
45 -- use_clause.
|
|
|
46
|
|
|
47 procedure P_Use_Package_Clause (Item_List : List_Id);
|
|
|
48 procedure P_Use_Type_Clause (Item_List : List_Id);
|
|
|
49
|
|
|
50 -----------------------
|
|
|
51 -- Append_Use_Clause --
|
|
|
52 -----------------------
|
|
|
53
|
|
|
54 procedure Append_Use_Clause
|
|
|
55 (Item_List : List_Id;
|
|
|
56 Use_Node : Node_Id;
|
|
|
57 Is_First : in out Boolean;
|
|
|
58 Is_Last : in out Boolean)
|
|
|
59 is
|
|
|
60 begin
|
|
|
61 if Token /= Tok_Comma then
|
|
|
62 if not Is_First then
|
|
|
63 Set_Prev_Ids (Use_Node);
|
|
|
64 end if;
|
|
|
65
|
|
|
66 Append (Use_Node, Item_List);
|
|
|
67 Is_Last := True;
|
|
|
68
|
|
|
69 else
|
|
|
70 Set_More_Ids (Use_Node);
|
|
|
71
|
|
|
72 if not Is_First then
|
|
|
73 Set_Prev_Ids (Use_Node);
|
|
|
74 else
|
|
|
75 Is_First := False;
|
|
|
76 end if;
|
|
|
77
|
|
|
78 Append (Use_Node, Item_List);
|
|
|
79 Scan; -- Past comma
|
|
|
80 end if;
|
|
|
81 end Append_Use_Clause;
|
|
|
82
|
|
|
83 ---------------------
|
|
|
84 -- 8.4 Use Clause --
|
|
|
85 ---------------------
|
|
|
86
|
|
|
87 -- USE_CLAUSE ::= USE_PACKAGE_CLAUSE | USE_TYPE_CLAUSE
|
|
|
88
|
|
|
89 -- The caller has checked that the initial token is USE
|
|
|
90
|
|
|
91 -- Error recovery: cannot raise Error_Resync
|
|
|
92
|
|
|
93 procedure P_Use_Clause (Item_List : List_Id) is
|
|
|
94 begin
|
|
|
95 Scan; -- past USE
|
|
|
96
|
|
|
97 if Token = Tok_Type or else Token = Tok_All then
|
|
|
98 P_Use_Type_Clause (Item_List);
|
|
|
99 else
|
|
|
100 P_Use_Package_Clause (Item_List);
|
|
|
101 end if;
|
|
|
102 end P_Use_Clause;
|
|
|
103
|
|
|
104 -----------------------------
|
|
|
105 -- 8.4 Use Package Clause --
|
|
|
106 -----------------------------
|
|
|
107
|
|
|
108 -- USE_PACKAGE_CLAUSE ::= use package_NAME {, package_NAME};
|
|
|
109
|
|
|
110 -- The caller has scanned out the USE keyword
|
|
|
111
|
|
|
112 -- Error recovery: cannot raise Error_Resync
|
|
|
113
|
|
|
114 procedure P_Use_Package_Clause (Item_List : List_Id) is
|
|
|
115 Is_First : Boolean := True;
|
|
|
116 Is_Last : Boolean := False;
|
|
|
117 Use_Node : Node_Id;
|
|
|
118 Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;
|
|
|
119
|
|
|
120 begin
|
|
|
121 if Token = Tok_Package then
|
|
|
122 Error_Msg_SC ("PACKAGE should not appear here");
|
|
|
123 Scan; -- Past PACKAGE
|
|
|
124 end if;
|
|
|
125
|
|
|
126 -- Loop through names in a single use_package_clause, generating an
|
|
|
127 -- N_Use_Package_Clause node for each name encountered.
|
|
|
128
|
|
|
129 loop
|
|
|
130 Use_Node := New_Node (N_Use_Package_Clause, Use_Sloc);
|
|
|
131 Set_Name (Use_Node, P_Qualified_Simple_Name);
|
|
|
132
|
|
|
133 -- Locally chain each name's use-package node
|
|
|
134
|
|
|
135 Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last);
|
|
|
136 exit when Is_Last;
|
|
|
137 end loop;
|
|
|
138
|
|
|
139 TF_Semicolon;
|
|
|
140 end P_Use_Package_Clause;
|
|
|
141
|
|
|
142 --------------------------
|
|
|
143 -- 8.4 Use Type Clause --
|
|
|
144 --------------------------
|
|
|
145
|
|
|
146 -- USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK};
|
|
|
147
|
|
|
148 -- The caller has checked that the initial token is USE, scanned it out
|
|
|
149 -- and that the current token is either ALL or TYPE.
|
|
|
150
|
|
|
151 -- Note: Use of ALL is an Ada 2012 feature
|
|
|
152
|
|
|
153 -- Error recovery: cannot raise Error_Resync
|
|
|
154
|
|
|
155 procedure P_Use_Type_Clause (Item_List : List_Id) is
|
|
|
156 Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;
|
|
|
157
|
|
|
158 All_Present : Boolean;
|
|
|
159 Is_First : Boolean := True;
|
|
|
160 Is_Last : Boolean := False;
|
|
|
161 Use_Node : Node_Id;
|
|
|
162
|
|
|
163 begin
|
|
|
164 if Token = Tok_All then
|
|
|
165 Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
|
|
|
166 All_Present := True;
|
|
|
167 Scan; -- Past ALL
|
|
|
168
|
|
|
169 if Token /= Tok_Type then
|
|
|
170 Error_Msg_SC ("TYPE expected");
|
|
|
171 end if;
|
|
|
172
|
|
|
173 else
|
|
|
174 pragma Assert (Token = Tok_Type);
|
|
|
175 All_Present := False;
|
|
|
176 end if;
|
|
|
177
|
|
|
178 if Ada_Version = Ada_83 then
|
|
|
179 Error_Msg_SC ("(Ada 83) use type not allowed!");
|
|
|
180 end if;
|
|
|
181
|
|
|
182 Scan; -- Past TYPE
|
|
|
183
|
|
|
184 -- Loop through subtype_marks in one use_type_clause, generating a
|
|
|
185 -- separate N_Use_Type_Clause node for each subtype_mark encountered.
|
|
|
186
|
|
|
187 loop
|
|
|
188 Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc);
|
|
|
189 Set_All_Present (Use_Node, All_Present);
|
|
|
190 Set_Used_Operations (Use_Node, No_Elist);
|
|
|
191
|
|
|
192 Set_Subtype_Mark (Use_Node, P_Subtype_Mark);
|
|
|
193
|
|
|
194 No_Constraint;
|
|
|
195
|
|
|
196 -- Locally chain each subtype_mark's use-type node
|
|
|
197
|
|
|
198 Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last);
|
|
|
199 exit when Is_Last;
|
|
|
200 end loop;
|
|
|
201
|
|
|
202 TF_Semicolon;
|
|
|
203 end P_Use_Type_Clause;
|
|
|
204
|
|
|
205 -------------------------------
|
|
|
206 -- 8.5 Renaming Declaration --
|
|
|
207 -------------------------------
|
|
|
208
|
|
|
209 -- Object renaming declarations and exception renaming declarations
|
|
|
210 -- are parsed by P_Identifier_Declaration (3.3.1)
|
|
|
211
|
|
|
212 -- Subprogram renaming declarations are parsed by P_Subprogram (6.1)
|
|
|
213
|
|
|
214 -- Package renaming declarations are parsed by P_Package (7.1)
|
|
|
215
|
|
|
216 -- Generic renaming declarations are parsed by P_Generic (12.1)
|
|
|
217
|
|
|
218 ----------------------------------------
|
|
|
219 -- 8.5.1 Object Renaming Declaration --
|
|
|
220 ----------------------------------------
|
|
|
221
|
|
|
222 -- Parsed by P_Identifier_Declarations (3.3.1)
|
|
|
223
|
|
|
224 -------------------------------------------
|
|
|
225 -- 8.5.2 Exception Renaming Declaration --
|
|
|
226 -------------------------------------------
|
|
|
227
|
|
|
228 -- Parsed by P_Identifier_Declarations (3.3.1)
|
|
|
229
|
|
|
230 -----------------------------------------
|
|
|
231 -- 8.5.3 Package Renaming Declaration --
|
|
|
232 -----------------------------------------
|
|
|
233
|
|
|
234 -- Parsed by P_Package (7.1)
|
|
|
235
|
|
|
236 --------------------------------------------
|
|
|
237 -- 8.5.4 Subprogram Renaming Declaration --
|
|
|
238 --------------------------------------------
|
|
|
239
|
|
|
240 -- Parsed by P_Subprogram (6.1)
|
|
|
241
|
|
|
242 -----------------------------------------
|
|
|
243 -- 8.5.2 Generic Renaming Declaration --
|
|
|
244 -----------------------------------------
|
|
|
245
|
|
|
246 -- Parsed by P_Generic (12.1)
|
|
|
247
|
|
|
248 end Ch8;
|
