-------------------------------------------------------------------------------
-- (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 Wf_Exit (Node           : in     STree.SyntaxNode;
                   The_Loop       : in     Dictionary.Symbol;
                   Condition_Node :    out STree.SyntaxNode) is
   If_Node, Local_Node : STree.SyntaxNode;
   Exit_Label          : STree.SyntaxNode;
begin
   -- The procedure checks that the conditions
   -- of Section 5.7 of the SPARK Definition apply to the exit statement.

   Local_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Node));
   -- ASSUME Local_Node = condition OR simple_name OR NULL
   if Local_Node = STree.NullNode then
      -- ASSUME Local_Node = NULL
      -- A simple exit statement - no label identifier and no exit condition
      Condition_Node := STree.NullNode;
      Exit_Label     := STree.NullNode;
   elsif Syntax_Node_Type (Node => Local_Node) = SP_Symbols.simple_name then
      -- ASSUME Local_Node = simple_name
      -- Exit has a label name
      Condition_Node := Next_Sibling (Current_Node => Local_Node); -- get the exit condition
      Exit_Label     := Child_Node (Current_Node => Local_Node); -- get the label identifier
   elsif Syntax_Node_Type (Node => Local_Node) = SP_Symbols.condition then
      -- ASSUME Local_Node = condition
      -- Must be an exit with a condition but no label
      Condition_Node := Local_Node;
      Exit_Label     := STree.NullNode;
   else
      Condition_Node := STree.NullNode;
      Exit_Label     := STree.NullNode;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Local_Node = condition OR simple_name OR NULL in Wf_Exit");
   end if;

   -- ASSUME Exit_Label = identifier OR NULL
   if Syntax_Node_Type (Node => Exit_Label) = SP_Symbols.identifier then
      -- ASSUME Exit_Label = identifier
      -- Exit names a loop label.  It must match the label attached to the
      -- most closely enclosing loop statement.
      if (not Dictionary.LoopHasName (The_Loop))
        or else LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Dictionary.GetSimpleName (The_Loop),
         Lex_Str2 => Node_Lex_String (Node => Exit_Label)) /=
        LexTokenManager.Str_Eq then
         -- Enclosing loop does not have a label, or labels
         -- are present, but do not match
         ErrorHandler.Semantic_Error
           (Err_Num   => 724,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exit_Label),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   elsif Exit_Label /= STree.NullNode then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Exit_Label = identifier OR NULL in Wf_Exit");
   end if;

   -- determine whether exit statement contains a when clause;
   -- ASSUME Condition_Node = condition OR NULL
   if Condition_Node = STree.NullNode then
      -- ASSUME Condition_Node = NULL
      -- exit statement is in an if_statement, therefore check that condition (3)
      -- of SPARK Definition Section 5.7 applies:
      -- check that exit-statement is last in its sequence of statements;
      if Is_Last_In_Sequence (Node => Node) then
         -- check that closest containing compound statement is an if_statement;
         Local_Node := Parent_Of_Sequence (Node => Node);
         if Syntax_Node_Type (Node => Local_Node) = SP_Symbols.if_statement then
            -- ASSUME Local_Node = if_statement
            -- check remainder of condition (3);
            If_Node := Local_Node;
            -- ASSUME If_Node = if_statement
            Local_Node := Child_Node (Current_Node => Local_Node);
            -- ASSUME Local_Node = condition
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Local_Node) = SP_Symbols.condition,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Local_Node = condition in Wf_Exit");
            Local_Node := Next_Sibling (Current_Node => Local_Node);
            -- ASSUME Local_Node = sequence_of_statements
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Local_Node) = SP_Symbols.sequence_of_statements,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Local_Node = sequence_of_statements in Wf_Exit");
            Local_Node := Next_Sibling (Current_Node => Local_Node);
            -- ASSUME Local_Node = elsif_part
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Local_Node) = SP_Symbols.elsif_part,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Local_Node = elsif_part in Wf_Exit");
            -- check that elsif_part is null;
            if Child_Node (Current_Node => Local_Node) = STree.NullNode then
               -- ASSUME Child_Node (Current_Node => Local_Node) = NULL
               Local_Node := Next_Sibling (Current_Node => Local_Node);
               -- ASSUME Local_Node = else_part
               SystemErrors.RT_Assert
                 (C       => Syntax_Node_Type (Node => Local_Node) = SP_Symbols.else_part,
                  Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Local_Node = else_part in Wf_Exit");
               -- check that else_part is null;
               if Child_Node (Current_Node => Local_Node) = STree.NullNode then
                  -- ASSUME Child_Node (Current_Node => Local_Node) = NULL
                  -- check that closest-containing compound statement is a loop statement;
                  Local_Node := Parent_Of_Sequence (Node => If_Node);
                  if Syntax_Node_Type (Node => Local_Node) /= SP_Symbols.loop_statement then
                     -- ASSUME Local_Node /= loop_statement
                     ErrorHandler.Control_Flow_Error
                       (Err_Type => ErrorHandler.Misplaced_Exit,
                        Position => Node_Position (Node => Node));
                  end if;
               else
                  ErrorHandler.Control_Flow_Error
                    (Err_Type => ErrorHandler.Misplaced_Exit,
                     Position => Node_Position (Node => Node));
               end if;
            else
               ErrorHandler.Control_Flow_Error (Err_Type => ErrorHandler.Misplaced_Exit,
                                                Position => Node_Position (Node => Node));
            end if;
         else
            ErrorHandler.Control_Flow_Error (Err_Type => ErrorHandler.Misplaced_Exit,
                                             Position => Node_Position (Node => Node));
         end if;
      else
         ErrorHandler.Control_Flow_Error (Err_Type => ErrorHandler.Misplaced_Exit,
                                          Position => Node_Position (Node => Node));
      end if;
   elsif Syntax_Node_Type (Node => Condition_Node) = SP_Symbols.condition then
      -- ASSUME Condition_Node = condition
      -- exit statement contains a when clause, therefore check that condition (2)
      -- of SPARK Definition Section 5.7 applies, i.e. check that closest-
      -- containing compound statement is a loop statement;
      Local_Node := Parent_Of_Sequence (Node => Node);
      if Syntax_Node_Type (Node => Local_Node) /= SP_Symbols.loop_statement then
         -- ASSUME Local_Node /= loop_statement
         ErrorHandler.Control_Flow_Error (Err_Type => ErrorHandler.Misplaced_Exit,
                                          Position => Node_Position (Node => Node));
      end if;
   else
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Condition_Node = condition OR NULL in Wf_Exit");
   end if;
end Wf_Exit;
