------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P A R . C H 8                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

pragma Style_Checks (All_Checks);
--  Turn off subprogram body ordering check. Subprograms are in order
--  by RM section rather than alphabetical

separate (Par)
package body Ch8 is

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Append_Use_Clause
     (Item_List : List_Id;
      Use_Node  : Node_Id;
      Is_First  : in out Boolean;
      Is_Last   : in out Boolean);
   --  Append a use_clause to the Item_List, appropriately setting the Prev_Ids
   --  and More_Ids flags for each split use node. The flags Is_First and
   --  Is_Last track position of subtype_marks or names within the original
   --  use_clause.

   procedure P_Use_Package_Clause (Item_List : List_Id);
   procedure P_Use_Type_Clause    (Item_List : List_Id);

   -----------------------
   -- Append_Use_Clause --
   -----------------------

   procedure Append_Use_Clause
     (Item_List : List_Id;
      Use_Node  : Node_Id;
      Is_First  : in out Boolean;
      Is_Last   : in out Boolean)
   is
   begin
      if Token /= Tok_Comma then
         if not Is_First then
            Set_Prev_Ids (Use_Node);
         end if;

         Append (Use_Node, Item_List);
         Is_Last := True;

      else
         Set_More_Ids (Use_Node);

         if not Is_First then
            Set_Prev_Ids (Use_Node);
         else
            Is_First := False;
         end if;

         Append (Use_Node, Item_List);
         Scan; --  Past comma
      end if;
   end Append_Use_Clause;

   ---------------------
   -- 8.4  Use Clause --
   ---------------------

   --  USE_CLAUSE ::= USE_PACKAGE_CLAUSE | USE_TYPE_CLAUSE

   --  The caller has checked that the initial token is USE

   --  Error recovery: cannot raise Error_Resync

   procedure P_Use_Clause (Item_List : List_Id) is
   begin
      Scan; -- past USE

      if Token = Tok_Type or else Token = Tok_All then
         P_Use_Type_Clause (Item_List);
      else
         P_Use_Package_Clause (Item_List);
      end if;
   end P_Use_Clause;

   -----------------------------
   -- 8.4  Use Package Clause --
   -----------------------------

   --  USE_PACKAGE_CLAUSE ::= use package_NAME {, package_NAME};

   --  The caller has scanned out the USE keyword

   --  Error recovery: cannot raise Error_Resync

   procedure P_Use_Package_Clause (Item_List : List_Id) is
      Is_First : Boolean := True;
      Is_Last  : Boolean := False;
      Use_Node : Node_Id;
      Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;

   begin
      if Token = Tok_Package then
         Error_Msg_SC ("PACKAGE should not appear here");
         Scan; --  Past PACKAGE
      end if;

      --  Loop through names in a single use_package_clause, generating an
      --  N_Use_Package_Clause node for each name encountered.

      loop
         Use_Node := New_Node (N_Use_Package_Clause, Use_Sloc);
         Set_Name (Use_Node, P_Qualified_Simple_Name);

         --  Locally chain each name's use-package node

         Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last);
         exit when Is_Last;
      end loop;

      TF_Semicolon;
   end P_Use_Package_Clause;

   --------------------------
   -- 8.4  Use Type Clause --
   --------------------------

   --  USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK};

   --  The caller has checked that the initial token is USE, scanned it out
   --  and that the current token is either ALL or TYPE.

   --  Note: Use of ALL is an Ada 2012 feature

   --  Error recovery: cannot raise Error_Resync

   procedure P_Use_Type_Clause (Item_List : List_Id) is
      Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;

      All_Present : Boolean;
      Is_First    : Boolean := True;
      Is_Last     : Boolean := False;
      Use_Node    : Node_Id;

   begin
      if Token = Tok_All then
         Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
         All_Present := True;
         Scan; --  Past ALL

         if Token /= Tok_Type then
            Error_Msg_SC ("TYPE expected");
         end if;

      else
         pragma Assert (Token = Tok_Type);
         All_Present := False;
      end if;

      if Ada_Version = Ada_83 then
         Error_Msg_SC ("(Ada 83) use type not allowed!");
      end if;

      Scan; --  Past TYPE

      --  Loop through subtype_marks in one use_type_clause, generating a
      --  separate N_Use_Type_Clause node for each subtype_mark encountered.

      loop
         Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc);
         Set_All_Present (Use_Node, All_Present);
         Set_Used_Operations (Use_Node, No_Elist);

         Set_Subtype_Mark (Use_Node, P_Subtype_Mark);

         No_Constraint;

         --  Locally chain each subtype_mark's use-type node

         Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last);
         exit when Is_Last;
      end loop;

      TF_Semicolon;
   end P_Use_Type_Clause;

   -------------------------------
   -- 8.5  Renaming Declaration --
   -------------------------------

   --  Object renaming declarations and exception renaming declarations
   --  are parsed by P_Identifier_Declaration (3.3.1)

   --  Subprogram renaming declarations are parsed by P_Subprogram (6.1)

   --  Package renaming declarations are parsed by P_Package (7.1)

   --  Generic renaming declarations are parsed by P_Generic (12.1)

   ----------------------------------------
   -- 8.5.1  Object Renaming Declaration --
   ----------------------------------------

   --  Parsed by P_Identifier_Declarations (3.3.1)

   -------------------------------------------
   -- 8.5.2  Exception Renaming Declaration --
   -------------------------------------------

   --  Parsed by P_Identifier_Declarations (3.3.1)

   -----------------------------------------
   -- 8.5.3  Package Renaming Declaration --
   -----------------------------------------

   --  Parsed by P_Package (7.1)

   --------------------------------------------
   -- 8.5.4  Subprogram Renaming Declaration --
   --------------------------------------------

   --  Parsed by P_Subprogram (6.1)

   -----------------------------------------
   -- 8.5.2  Generic Renaming Declaration --
   -----------------------------------------

   --  Parsed by P_Generic (12.1)

end Ch8;