-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT 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 the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

----------------------------------------------------------------------------
-- This unit WFFs use type clauses that appear _inside_ a package body only.
-- Currently these are not allowed in SPARK83 at all, and in SPARK95, we
-- WFF their position (they must directly follow the embedded package to
-- which they refer), but report they are otherwise unimplemented.
--
-- This does NOT WFF use type clauses that appear as part of a context
-- clause - these are handled separately by
-- Sem.CompUnit.wf_context_clause.use_clause
----------------------------------------------------------------------------
separate (Sem.CompUnit)
procedure Wf_Use_Type_Clause (Node : in STree.SyntaxNode) is
   It                         : STree.Iterator;
   Parent_Item_Rep, Next_Node : STree.SyntaxNode;

   procedure Process_Dotted_Simple_Name (Node   : in STree.SyntaxNode;
                                         Parent : in STree.SyntaxNode)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Parent,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.dotted_simple_name and
   --#   (Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.initial_declarative_item_rep or
   --#      Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.context_clause_rep);
   is
      OK : Boolean;

      procedure Check_Position
        (Node_Pos    : in     LexTokenManager.Token_Position;
         Parent      : in     STree.SyntaxNode;
         Pack_String : in     LexTokenManager.Lex_String;
         Pos_OK      :    out Boolean)
      --# global in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     STree.Table;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --# derives ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         Node_Pos,
      --#                                         Pack_String,
      --#                                         Parent,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table &
      --#         Pos_OK                     from LexTokenManager.State,
      --#                                         Pack_String,
      --#                                         Parent,
      --#                                         STree.Table;
      --# pre Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.initial_declarative_item_rep or
      --#   Syntax_Node_Type (Parent, STree.Table) = SP_Symbols.context_clause_rep;
      is
         Ident : LexTokenManager.Lex_String;
      begin
         if Syntax_Node_Type (Node => Parent) = SP_Symbols.initial_declarative_item_rep then
            -- should follow a package declaration
            Ident := Find_Previous_Package (Node => Parent);

            if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ident,
                                                                    Lex_Str2 => LexTokenManager.Null_String) =
              LexTokenManager.Str_Eq then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 112,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Id_Str    => LexTokenManager.Null_String);
               Pos_OK := False;
            elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ident,
                                                                       Lex_Str2 => Pack_String) /=
              LexTokenManager.Str_Eq then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 301,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Id_Str    => Ident);
               Pos_OK := False;
            else
               Pos_OK := True;
            end if;
         else
            Pos_OK := False;
         end if;
      end Check_Position;

   begin -- Process_Dotted_Simple_Name
      Check_Position
        (Node_Pos    => Node_Position (Node => Node),
         Parent      => Parent,
         Pack_String => Node_Lex_String (Node => Last_Child_Of (Start_Node => Node)),
         Pos_OK      => OK);
      if OK then
         -- Position is OK, but alas "use type" is currently unimplemented...
         -- If this is ever completed, then remember to revise the comment
         -- at the top of this unit!
         ErrorHandler.Semantic_Error
           (Err_Num   => 110,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end Process_Dotted_Simple_Name;

begin -- Wf_Use_Type_Clause
   case CommandLineData.Content.Language_Profile is
      when CommandLineData.SPARK83 =>
         ErrorHandler.Semantic_Error
           (Err_Num   => 550,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      when CommandLineData.SPARK95_Onwards =>
         -- Could be "use type E.T1, E.T2;" so we need to loop and check
         -- the position of each type mark.
         Parent_Item_Rep := Parent_Node (Current_Node => Node);
         -- ASSUME Parent_Item_Rep = initial_declarative_item_rep OR context_clause_rep
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Parent_Item_Rep) = SP_Symbols.initial_declarative_item_rep
              or else Syntax_Node_Type (Node => Parent_Item_Rep) = SP_Symbols.context_clause_rep,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Parent_Item_Rep = initial_declarative_item_rep OR context_clause_rep in Wf_Use_Type_Clause");
         It := Find_First_Node (Node_Kind    => SP_Symbols.dotted_simple_name,
                                From_Root    => Node,
                                In_Direction => STree.Down);
         while not STree.IsNull (It) loop
            Next_Node := Get_Node (It => It);
            --# assert Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.dotted_simple_name and
            --#   Next_Node = Get_Node (It) and
            --#   (Syntax_Node_Type (Parent_Item_Rep, STree.Table) = SP_Symbols.initial_declarative_item_rep or
            --#      Syntax_Node_Type (Parent_Item_Rep, STree.Table) = SP_Symbols.context_clause_rep);
            Process_Dotted_Simple_Name (Node   => Next_Node,
                                        Parent => Parent_Item_Rep);
            It := STree.NextNode (It);
         end loop;
   end case;
end Wf_Use_Type_Clause;
