-------------------------------------------------------------------------------
-- (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.CompUnit.WalkStatements)
procedure Up_Case (Node : in STree.SyntaxNode) is
   Unused1      : Dictionary.Symbol;
   Case_Flags   : Typ_Case_Flags;
   Unused2      : Typ_Type_Bound;
   Unused3      : Typ_Type_Bound;
   Complete_ADT : CompleteCheck.T;
   Others_Found : Boolean;
   Current_Node : STree.SyntaxNode;
begin
   --# accept Flow, 10, Unused1, "Expected ineffective assignment" &
   --#        Flow, 10, Unused2, "Expected ineffective assignment" &
   --#        Flow, 10, Unused3, "Expected ineffective assignment";
   Case_Stack.Pop
     (Case_Flags   => Case_Flags,
      Complete_ADT => Complete_ADT,
      Sym          => Unused1,
      Lower_Bound  => Unused2,
      Upper_Bound  => Unused3);
   --# end accept;

   -- if there is an others clause record the fact and inform ADT
   Current_Node :=
     Child_Node
     (Current_Node => Next_Sibling (Current_Node => Next_Sibling (Current_Node => Child_Node (Current_Node => Node))));
   -- ASSUME Current_Node = sequence_of_statements OR NULL
   if Current_Node = STree.NullNode then
      -- ASSUME Current_Node = NULL
      Others_Found := False;
   elsif Syntax_Node_Type (Node => Current_Node) = SP_Symbols.sequence_of_statements then
      -- ASSUME Current_Node = sequence_of_statements
      Others_Found := True;
      -- check to see if case was already complete before others found
      if Case_Flags.Check_Completeness and then CompleteCheck.IsComplete (Complete_ADT) = CompleteCheck.Complete then
         ErrorHandler.Semantic_Warning
           (Err_Num  => 11,
            Position => Node_Position (Node => Current_Node),
            Id_Str   => LexTokenManager.Null_String);
      end if;
      -- now signal "others found" to completeness checker
      CompleteCheck.SeenOthers (Complete_ADT);
   else
      Others_Found := False;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Current_Node = sequence_of_statements OR NULL in Up_Case");
   end if;

   if Case_Flags.Check_Completeness then
      if Complete_ADT.Undeterminable and then not Others_Found then
         ErrorHandler.Semantic_Warning
           (Err_Num  => 304,
            Position => Node_Position (Node => Node),
            Id_Str   => LexTokenManager.Null_String);
      elsif CompleteCheck.IsComplete (Complete_ADT) = CompleteCheck.Incomplete then
         ErrorHandler.Semantic_Error
           (Err_Num   => 408,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end if;

   if Case_Flags.Signal_Out_Of_Range and then Case_Flags.Out_Of_Range_Seen then
      ErrorHandler.Semantic_Warning
        (Err_Num  => 303,
         Position => Node_Position (Node => Node),
         Id_Str   => LexTokenManager.Null_String);
   end if;

   if Case_Flags.Warn_No_Others
     and then not Others_Found
     and then not (Case_Flags.Check_Completeness -- don't output
                     and then Complete_ADT.Undeterminable) then -- 304 twice.
      ErrorHandler.Semantic_Warning
        (Err_Num  => 304,
         Position => Node_Position (Node => Node),
         Id_Str   => LexTokenManager.Null_String);
   end if;

   if Case_Flags.Others_Mandatory and then not Others_Found then
      ErrorHandler.Semantic_Error
        (Err_Num   => 411,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;
   --# accept Flow, 33, Unused1, "Expected to be neither referenced nor exported" &
   --#        Flow, 33, Unused2, "Expected to be neither referenced nor exported" &
   --#        Flow, 33, Unused3, "Expected to be neither referenced nor exported";
end Up_Case;
