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-2012, 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
26pragma Style_Checks (All_Checks);
27--  Turn off subprogram body ordering check. Subprograms are in order
28--  by RM section rather than alphabetical
29
30separate (Par)
31package 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         if Ada_Version < Ada_2012 then
114            Error_Msg_SC ("|`USE ALL TYPE` is an Ada 2012 feature");
115            Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
116         end if;
117
118         All_Present := True;
119         Scan; -- past ALL
120
121      else
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
190end Ch8;
191