-------------------------------------------------------------------------------
-- (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 (ErrorHandler.Conversions.ToString)
procedure WarningWithoutPosition
  (Err_Num          : in     Error_Types.NumericError;
   With_Explanation : in     Boolean;
   E_Str            : in out E_Strings.T)
is

   Unit_Typ : SP_Symbols.SP_Symbol;

   procedure WarningWithoutPositionExpl (E_Str : in out E_Strings.T)
   --# global in Err_Num;
   --# derives E_Str from *,
   --#                    Err_Num;
      is separate;
   -- Note that the parameter names for this subunit are chosen to make it as easy as
   --      possible to auto-generate the subunit from this, its parent, file.  The
   --      generation requires copying the case statement below, stripping out the
   --      current Append'Thing' statements and adding an AppendString for the
   --      explanatory text that is delineated by --! comments.

   procedure Append_Explanation
   --# global in     Err_Num;
   --#        in     With_Explanation;
   --#        in out E_Str;
   --# derives E_Str from *,
   --#                    Err_Num,
   --#                    With_Explanation;
   is
      Explanation_String : E_Strings.T := E_Strings.Empty_String;
   begin
      if With_Explanation then
         -- we need to at least look for an explanation
         WarningWithoutPositionExpl (Explanation_String);
         if E_Strings.Get_Length (E_Str => Explanation_String) > 0 then
            -- there actually is one
            E_Strings.Append_String (E_Str => E_Str,
                                     Str   => ErrorHandler.Explanation_Prefix);
            E_Strings.Append_Examiner_String (E_Str1 => E_Str,
                                              E_Str2 => Explanation_String);
            E_Strings.Append_String (E_Str => E_Str,
                                     Str   => ErrorHandler.Explanation_Postfix);
         end if;
      end if;
   end Append_Explanation;

begin

   -- HTML Directives
   --! <NameFormat> <"warning-"><Name>
   --! <ErrorFormat> <"--- Warning : "><Name><" : "><Error>

   case Err_Num.ErrorNum is
      when 9 =>
         Unit_Typ := SP_Symbols.SP_Symbol'Val (Err_Num.Name2.Pos);
         --! <Error> The body of XXX has a hidden exception handler - analysis and verification of contracts for this handler have not been performed.
         --! Issued when a --# hide XXX annotation is used to hide a user-defined exception handler.  (warning control file
         --! keyword:<b> handler_parts</b>)
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "The body of ");
         case Unit_Typ is
            when SP_Symbols.entry_body =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "entry ");
            when SP_Symbols.subprogram_implementation =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "subprogram ");
            when SP_Symbols.task_body =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "task ");
            when others =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "unknown_node_type ");
         end case;
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => " has a hidden exception handler - analysis and verification of contracts " &
              "for this handler have not been performed");

      when 10 =>
         Unit_Typ := SP_Symbols.SP_Symbol'Val (Err_Num.Name2.Pos);
         --! <Error> XXX is hidden - hidden text is ignored by the Examiner
         --! Issued when a --# hide XXX annotation is used.  (warning control file keyword:<b> hidden_parts</b>)
         case Unit_Typ is
            when SP_Symbols.subprogram_implementation =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "The body of subprogram ");
            when SP_Symbols.private_part =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "The private part of package ");
            when SP_Symbols.package_implementation =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "The body of package ");
            when SP_Symbols.package_initialization =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "The initialization of package ");
            when SP_Symbols.protected_type_declaration =>
               E_Strings.Append_String (E_Str => E_Str,
                                        Str   => "The private part of protected type  ");
            when others =>
               null;  -- never happens
         end case;
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => " is hidden - hidden text is ignored by the Examiner");

      when 400 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Variable ");
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => " is declared but not used");
         --! Issued when a variable declared in a subprogram is neither
         --! referenced, nor updated.
         --! (warning control file keyword: <b>unused_variables</b>)

      when 402 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Default assertion planted to cut loop");
         --! In order to prove properties of code containing loops, the
         --! loop must be &quot;cut&quot; with
         --! a suitable assertion statement.  When generating run-time checks,
         --! the Examiner
         --! inserts a simple assertion to cut any loops which do not have one
         --! supplied
         --! by the user.  The assertion is placed at the point where this
         --! warning appears in
         --! the listing file.  The default assertion asserts that the
         --! subprogram's precondition
         --! (if any) is satisfied, that all imports to it are in their
         --! subtypes and that any for
         --! loop counter is in its subtype.  In many cases this provides
         --! sufficient information
         --! to complete a proof of absence of run-time errors.  If more
         --! information is required,
         --! then the user can supply an assertion and the Examiner will
         --! append the above information
         --! to it. (warning control file keyword: <b>default_loop_assertions</b>)

      when 403 =>
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => " is declared as a variable but used as a constant");
         --! XXX is a variable which was initialized at declaration but
         --! whose value is only ever
         --! read not updated; it could therefore have been declared as
         --! a constant. (warning control
         --! file keyword: <b>constant_variables</b>)

      when 404 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "Subprogram imports variables of abstract types for which run-time checks cannot be generated");

      when 405 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "VCs for statements including real numbers are approximate");
         --! The Examiner generates VCs associated with
         --! real numbers using perfect arithmetic rather than the machine
         --! approximations used on the
         --! target platform.  It is possible that rounding errors might
         --! cause a Constraint_Error even
         --! if these run-time check proofs are completed satisfactorily.
         --! (warning control file keyword: <b>real_rtcs</b>)

      when 406 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "VC Generator unable to create output files. Permission is required to " &
              "create directories and files in the output directory");
         --! This message is echoed to the screen if the Examiner is unable
         --! to create output files for the VCs being generated
         --! (for instance, if the user does not have write
         --! permission for the output directory).

      when 407 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "This package requires a body.  Care should be taken to " &
              "provide one " &
              "because an Ada compiler will not detect its omission");
         --! Issued where SPARK own variable and initialization annotations
         --! make it clear that a
         --! package requires a body but where no Ada requirement for a body
         --! exists.

      when 408 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "VCs could not be generated for this subprogram owing to " &
              "semantic errors in its " &
              "specification or body.  Unprovable (False) VC generated");
         --! Semantic errors prevent VC Generation, so a single False VC
         --! is produced. This will be detected and reported by POGS.

      when 409 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "VCs could not be generated for this subprogram due to " &
              "its size and/or complexity " &
              "exceeding the capacity of the VC Generator.  Unprovable (False) VC generated");
         --! A subprogram which has excessive complexity of data structure
         --! or number of paths may cause the VC Generator to exceed its capacity.
         --! A single False VC is generated in this case to make sure this
         --! error is detected in subsequent proof and analysis with POGS

      when 410 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Task or interrupt handler ");
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => " is either unavailable (hidden) or has semantic errors in " &
              "its specification which prevent " &
              "partition-wide flow analysis being carried out");
         --! Partition-wide flow analysis is performed by checking all
         --! packages withed by the main program for
         --! tasks and interrupt handlers and constructing an overall flow
         --! relation that captures their cumulative
         --! effect.  It is for this reason that SPARK requires task and
         --! protected types to be declared in package
         --! specifications.  If a task or protected type which contains
         --! an interrupt handler, is hidden from the
         --! Examiner (in a hidden package private part) or contains errors
         --! in it specification, the partition-wide
         --! flow analysis cannot be
         --! constructed correctly and is therefore suppressed.  Correct the
         --! specification of the affected tasks
         --! and (temporarily if desired) make them visible to the Examiner.

      when 411 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Task type ");
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => " is unavailable and has not been considered in the shared variable check");
         --! The Examiner checks that there is no potential sharing of
         --! unprotected data between tasks.  If a task type
         --! is hidden from the Examiner in a hidden package private
         --! part, then it is not possible to check whether that
         --! task may share unprotected data.

      when 412 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Task type ");
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => " is unavailable and has not been considered in the max-one-in-a-queue check");
         --! The Examiner checks that no more than one task can suspend on
         --! a single object.  If a task
         --! is hidden from the Examiner in a hidden package private part,
         --! then it is not possible to check whether that
         --! task may suspend on the same object as another task.

      when 413 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Task or main program ");
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Err_Num.Scope);
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => " has errors in its annotations. The shared variable and max-one-in-a-queue checks may be incomplete");
         --! The Examiner checks that no more than one task can suspend on a
         --! single object and that there is no
         --! potential sharing of unprotected data between tasks.  These checks
         --! depend on the accuracy of the annotations
         --! on the task types withed by the main program.  If these annotations
         --! contain errors, then any reported
         --! violations of the shared variable and max-one-in-a-queue checks will
         --! be correct; however, the check
         --! may be incomplete.  The errors in the task annotations should be corrected.

      when 414 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "Long output file name has been truncated");
         --! Raised if an output file name is longer than the
         --! limit imposed by the operating system and has been truncated.
         --! Section 4.7 of the Examiner User Manual describes how the output file names
         --! are constructed. If this message is seen there is a possibility
         --! that the output from two
         --! or more subprograms will be written to the same file name,
         --! if they have a sufficiently large number of characters in common.

      when 415 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "The analysis of generic packages is not yet supported. " &
              "It will be supported in a future release of the Examiner");

      when 420 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "Instance of SEPR 2124 found. An extra VC will " &
              "be generated here and must be discharged to " &
              "ensure absence of run-time errors. Please seek advice " &
              "for assistance with this issue");
         --! In release 7.5 of the Examiner, a flaw in the VC generation
         --! was fixed such that subcomponents of records and elements of
         --! arrays when used as &quot;out&quot; or &quot;in out&quot;
         --! parameters will now generate an
         --! additional VC to verify absence of run-time errors. This warning
         --! flags an instance of this occurrence. Please read the release
         --! note and/or seek advice for assistance with this issue.

      when 425 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "The -vcg switch should be used with the selected language profile");
         --! A code generator language profile such as KCG is in use
         --! and so conditional flow errors may be present in the subprogram.
         --! Therefore the -vcg switch must be used to generate VCs and the VCs
         --! related to definedness discharged using the proof tools.

      when 426 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "The with_clause contains a reference to a public child of the package. " &
              "The Examiner will not detect mutual recursion between subprograms of the two packages");
         --! A code generator language profile such as KCG allows a package body to
         --! with its own public child which is not normally permitted in SPARK.
         --! The removal of this restriction means that the Examiner will not
         --! detect mutual recursion between subprograms declared in the visible
         --! parts of the package and its child. The code generator is expected
         --! to guarantee the absence of recursion.

      when 430 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "SLI generation abandoned owing to syntax or semantic errors or multiple units in a single source file");

      when 431 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "Preconditions on the main program are assumed to be true and not checked by the VC generation system");

      when 444 =>
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => "Assumptions cannot be checked and must be justified with an accept annotation");

      when 495 =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "The VC file ");
         Append_Name (E_Str => E_Str,
                      Name  => Err_Num.Name1,
                      Scope => Dictionary.NullScope);
         E_Strings.Append_String
           (E_Str => E_Str,
            Str   => " has a pathname longer than 255 characters which can produce unexpected problems " &
              "on Windows with respect to the SPARK tools (undischarged VCs) and other tools");
         --! There is little that can be done to work around this as this
         --! is a fundamental limitation of Windows. You could try one of the
         --! following: Perform analysis higher up in the directory tree (i.e.
         --! in C:\a instead of C:\project_name\spark\analysis). You could try
         --! remapping a directory to a new drive to do the same (google for subst).
         --! You could try renaming or restructuring your program to flatten the
         --! structure a bit. And finally you can perform analysis on a UNIX system
         --! such as Mac OSX or GNU/Linux as they do not suffer from this problem.

      when others =>
         E_Strings.Append_String (E_Str => E_Str,
                                  Str   => "UNKNOWN ERROR NUMBER PASSED TO WarningWithoutPosition");

   end case;

   Append_Explanation;
   E_Strings.Append_String (E_Str => E_Str,
                            Str   => ".");
end WarningWithoutPosition;
