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