-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

separate (Sem.Wf_Package_Declaration)
procedure Add_Child
  (Root_Id_Node : in     STree.SyntaxNode;
   Is_Private   : in     Boolean;
   Scope        : in     Dictionary.Scopes;
   Child_Sym    :    out Dictionary.Symbol;
   Child_Str    :    out LexTokenManager.Lex_String)
is
   Curr_Node  : STree.SyntaxNode;
   Curr_Sym   : Dictionary.Symbol;
   Parent_Sym : Dictionary.Symbol := Dictionary.NullSymbol;
   Child_Sort : Dictionary.PackageSort;
begin
   Curr_Node := Root_Id_Node;
   Child_Str := Node_Lex_String (Node => Curr_Node);
   Curr_Sym  :=
     Dictionary.LookupItem (Name              => Child_Str,
                            Scope             => Scope,
                            Context           => Dictionary.ProofContext,
                            Full_Package_Name => False);
   while Syntax_Node_Type (Node => Next_Sibling (Current_Node => Parent_Node (Current_Node => Curr_Node))) =
     SP_Symbols.identifier loop
      -- to handle multiple prefixes
      if Dictionary.Is_Null_Symbol (Curr_Sym) then
         -- not declared or visible
         Parent_Sym := Dictionary.NullSymbol;
         ErrorHandler.Semantic_Error
           (Err_Num   => 140,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Curr_Node),
            Id_Str    => Child_Str);
         exit;
      end if;

      if not Dictionary.IsPackage (Curr_Sym) then
         -- can't be a parent
         Curr_Sym   := Dictionary.NullSymbol;
         Parent_Sym := Dictionary.NullSymbol;
         ErrorHandler.Semantic_Error
           (Err_Num   => 18,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Curr_Node),
            Id_Str    => Child_Str);
         exit;
      end if;

      -- Child_Str (Curr_Sym) is visible and its a package
      STree.Set_Node_Lex_String (Sym  => Curr_Sym,
                                 Node => Curr_Node);
      Parent_Sym := Curr_Sym;
      Curr_Node  := Next_Sibling (Current_Node => Parent_Node (Current_Node => Curr_Node));
      --# assert STree.Table = STree.Table~ and
      --#   Syntax_Node_Type (Root_Id_Node, STree.Table) = SP_Symbols.identifier and
      --#   Syntax_Node_Type (Curr_Node, STree.Table) = SP_Symbols.identifier;
      Child_Str := Node_Lex_String (Node => Curr_Node);
      Curr_Sym  :=
        Dictionary.LookupSelectedItem
        (Prefix   => Curr_Sym,
         Selector => Child_Str,
         Scope    => Scope,
         Context  => Dictionary.ProofContext);
   end loop;

   if not Dictionary.Is_Null_Symbol (Curr_Sym) then
      -- child already declared
      ErrorHandler.Semantic_Error
        (Err_Num   => 10,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Curr_Node),
         Id_Str    => Child_Str);
   elsif not Dictionary.Is_Null_Symbol (Parent_Sym) then
      -- check that Child_Str has not been declared as a body stub
      Curr_Sym :=
        Dictionary.LookupImmediateScope
        (Name    => Child_Str,
         Scope   => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                               The_Unit       => Parent_Sym),
         Context => Dictionary.ProgramContext);
      if not Dictionary.Is_Null_Symbol (Curr_Sym) and then Dictionary.HasBodyStub (Curr_Sym) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 10,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Curr_Node),
            Id_Str    => Child_Str);
      elsif not Dictionary.Is_Null_Symbol (Curr_Sym) then
         STree.Set_Node_Lex_String (Sym  => Curr_Sym,
                                    Node => Curr_Node);
      end if;

      -- check that Child_Str not inherited by parent of private child:
      Curr_Sym :=
        Dictionary.LookupItem
        (Name              => Child_Str,
         Scope             => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                         The_Unit       => Parent_Sym),
         Context           => Dictionary.ProofContext,
         Full_Package_Name => False);
      if Is_Private and then not Dictionary.Is_Null_Symbol (Curr_Sym) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 10,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Curr_Node),
            Id_Str    => Child_Str);
      elsif not Dictionary.Is_Null_Symbol (Curr_Sym) then
         STree.Set_Node_Lex_String (Sym  => Curr_Sym,
                                    Node => Curr_Node);
      end if;
   end if;

   if not Dictionary.Is_Null_Symbol (Parent_Sym) then
      if Is_Private then
         Child_Sort := Dictionary.PrivateChild;
      else
         Child_Sort := Dictionary.Public;
      end if;
      Dictionary.AddChildPackage
        (TheParent     => Parent_Sym,
         Sort          => Child_Sort,
         Name          => Child_Str,
         Comp_Unit     => ContextManager.Ops.Current_Unit,
         Specification => Dictionary.Location'(Start_Position => Node_Position (Node => Root_Id_Node),
                                               End_Position   => Node_Position (Node => Root_Id_Node)),
         Scope         => Scope,
         ThePackage    => Child_Sym);
   else
      -- Parent is not valid (i.e. undeclared or not a package) so we can't do any more.
      -- Signal failure back to caller with null child symbol
      Child_Sym := Dictionary.NullSymbol;
      Child_Str := LexTokenManager.Null_String;
   end if;
end Add_Child;
