---------------------------------------------------------------------------
--                                                                       --
--  Component:                                                           --
--                                                                       --
--     package body Report                                               --
--                                                                       --
--  Copyrights:                                                          --
--                                                                       --
--     Copyright (c) 1998, Chris Nettleton Software                      --
--                                                                       --
--  Credits:                                                             --
--                                                                       --
--     This software is part of the XGC Ada library. It was developed by --
--     Chris Nettleton Software under European Space Agency contract     --
--     number 11935/NL/JG. Permission to use, copy, modify,              --
--     and distribute this software is freely granted, provided that     --
--     this notice is preserved.                                         --
--                                                                       --
--  Revision:                                                            --
--                                                                       --
--     $Id:$                                                             --
--                                                                       --
---------------------------------------------------------------------------

with Text_IO;
use Text_IO;

package body Report is

   Test_Name : String (1 .. 70) := (others => ' ');
   Test_Name_Last : Integer := 0;

   Test_Failed : Boolean := False;


   ----------
   -- Test --
   ----------

   procedure Test (Name, Description : in String) is
   begin
      Put (",.,. ");
      Put (Name);
      Put (" GTS Version 0.1");
      New_Line;

      Put ("---- ");
      Put (Description);
      Put (".");
      New_Line;

      for i in 1 .. Name'Last loop
         Test_Name (i) := Name (i);
      end loop;

      Test_Name_Last := Name'Last;

      Test_Failed := False;
   end Test;

   ------------
   -- Failed --
   ------------

   procedure Failed (Description : in String) is
   begin
      Test_Failed := True;

      Put ("   * ");
      Put (Test_Name (1 .. Test_Name_Last));
      Put (" ");
      Put (Description);
      Put (".");
      New_Line;

   end Failed;

   -------------
   -- Comment --
   -------------

   procedure Comment (Description : in String) is
   begin
      Test_Failed := True;

      Put ("   - ");
      Put (Test_Name (1 .. Test_Name_Last));
      Put (" ");
      Put (Description);
      Put (".");
      New_Line;
   end Comment;

   ------------
   -- Result --
   ------------

   procedure Result is
   begin
      if Test_Failed then
         Put ("**** ");
         Put (Test_Name (1 .. Test_Name_Last));
         Put ("  FAILED ****************************.");
         New_Line;
      else
         Put ("==== ");
         Put (Test_Name (1 .. Test_Name_Last));
         Put ("  PASSED ============================.");
         New_Line;
      end if;
   end Result;

end Report;