--  Copyright 2002-2003 Simon Wright <simon@pushface.org>

--  This package 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 2, or
--  (at your option) any later version. This package 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 this package; see file COPYING.  If not,
--  write to the Free Software Foundation, 59 Temple Place - Suite
--  330, Boston, MA 02111-1307, USA.

--  $Id: stream_test.adb,v 1.7.2.5 2003/01/06 20:45:30 simon Exp $

with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Ada.Text_IO;
with Assertions;
with BC.Support.Memory_Streams;
with Collection_Test_Support;
with Set_Test_Support;
with Stream_Test_Support;
with Stream_Test_Support.TCB;
with Stream_Test_Support.TCD;
with Stream_Test_Support.TCU;

procedure Stream_Test is

   use Ada.Streams.Stream_IO;
   use Ada.Text_IO;
   use Assertions;
   use Collection_Test_Support;
   use Collection_Test_Support.Collections;
   use Set_Test_Support;
   use Set_Test_Support.Sets;
   use Stream_Test_Support;

   procedure Setup (C : in out Abstract_Collection'Class; Using : String);
   procedure Setup (C : in out Abstract_Collection'Class; Using : String) is
   begin
      Clear (C);
      for I in Using'Range loop
         Append (C, Using (I));
      end loop;
   end Setup;

   procedure Setup (S : in out Abstract_Set'Class; Using : String);
   procedure Setup (S : in out Abstract_Set'Class; Using : String) is
   begin
      Clear (S);
      for I in Using'Range loop
         Add (S, Using (I));
      end loop;
   end Setup;

   --  Debug support only
   procedure Image (C : Abstract_Base_Containers.Container'Class);
   pragma Warnings (Off, Image);
   procedure Image (C : Abstract_Base_Containers.Container'Class) is
      It : Abstract_Base_Containers.Iterator'Class :=
        Abstract_Base_Containers.New_Iterator (C);
      use Abstract_Base_Containers;
   begin
      Put_Line ("start");
      while not Is_Done (It) loop
         Ada.Text_IO.Put_Line ("  " & Image (Current_Item (It)));
         Next (It);
      end loop;
      Put_Line ("end");
   end Image;

   F : Ada.Streams.Stream_IO.File_Type;

begin

   Put_Line ("Starting Stream tests");

   Create (F, Name => "test.dat");

   declare
      C1, C2 : CB.Collection;
      use CB;
   begin

      Put_Line ("...Bounded Collections");

      Reset (F, Mode => Out_File);
      Setup (C1, "");
      Setup (C2, "initial");
      Assertion (C1 /= C2, "CB1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "CB2: Collections are unequal");

      Reset (F, Mode => Out_File);
      Setup (C1, "second");
      Setup (C2, "SECOND");
      Assertion (C1 /= C2, "CB3: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "CB4: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "CBX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : CD.Collection;
      use CD;
   begin

      Put_Line ("...Dynamic Collections");

      Reset (F, Mode => Out_File);
      Setup (C1, "");
      Setup (C2, "initial");
      Assertion (C1 /= C2, "CD1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "CD2: Collections are unequal");

      Reset (F, Mode => Out_File);
      Setup (C1, "second");
      Setup (C2, "SECOND");
      Assertion (C1 /= C2, "CD3: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "CD4: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "CDX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : CU.Collection;
      use CU;
   begin

      Put_Line ("...Unbounded Collections");

      Reset (F, Mode => Out_File);
      Setup (C1, "");
      Setup (C2, "initial");
      Assertion (C1 /= C2, "CU1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "CU2: Collections are unequal");

      Reset (F, Mode => Out_File);
      Setup (C1, "second");
      Setup (C2, "SECOND");
      Assertion (C1 /= C2, "CU3: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "CU4: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "CUX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      S1, S2 : SU.Set;
      use SU;
   begin

      Put_Line ("...Unbounded Sets");

      Reset (F, Mode => Out_File);
      Setup (S1, "");
      Setup (S2, "initial");
      Assertion (S1 /= S2, "SU1: Sets are equal");
      Set'Output (Stream (F), S1);
      Reset (F, Mode => In_File);
      S2 := Set'Input (Stream (F));
      Assertion (S1 = S2, "SU2: Sets are unequal");

      Reset (F, Mode => Out_File);
      Setup (S1, "second");
      Setup (S2, "SECOND");
      Assertion (S1 /= S2, "SU3: Sets are equal");
      Set'Output (Stream (F), S1);
      Reset (F, Mode => In_File);
      S2 := Set'Input (Stream (F));
      Assertion (S1 = S2, "SU4: Sets are unequal");

   exception
      when E : others =>
         Assertion (False, "SUX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : ICB.Collection;
      use ICB;
   begin

      Put_Line ("...Bounded complex Collections");

      Reset (F, Mode => Out_File);
      Append (C1, (Of_Kind => I, I => 1234));
      Append (C1, (Of_Kind => C, C => 'Z'));
      Append (C1, (Of_Kind => Stream_Test_Support.F, F => 0.54321));
      Clear (C2);
      Assertion (C1 /= C2, "ICB1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "ICB2: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "ICBX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : ICD.Collection;
      use ICD;
   begin

      Put_Line ("...Dynamic complex Collections");

      Reset (F, Mode => Out_File);
      Append (C1, (Of_Kind => I, I => 1234));
      Append (C1, (Of_Kind => C, C => 'Z'));
      Append (C1, (Of_Kind => Stream_Test_Support.F, F => 0.54321));
      Clear (C2);
      Assertion (C1 /= C2, "ICD1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "ICD2: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "ICDX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : ICU.Collection;
      use ICU;
   begin

      Put_Line ("...Unbounded complex Collections");

      Reset (F, Mode => Out_File);
      Append (C1, (Of_Kind => I, I => 1234));
      Append (C1, (Of_Kind => C, C => 'Z'));
      Append (C1, (Of_Kind => Stream_Test_Support.F, F => 0.54321));
      Clear (C2);
      Assertion (C1 /= C2, "ICU1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "ICU2: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "ICUX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare

      B1, B2, S1, S2 : Base_Class_P;

   begin

      Put_Line ("...Classwide pointers");

      Reset (F, Mode => Out_File);

      B1 := new Brother'(I => 16#aabb#);
      S1 := new Sister'(B => True);

      Base_Class_P'Output (Stream (F), B1);
      Base_Class_P'Output (Stream (F), S1);

      Reset (F, Mode => In_File);

      B2 := Base_Class_P'Input (Stream (F));
      S2 := Base_Class_P'Input (Stream (F));

      Assertion (B2.all = B1.all, "P1: values are unequal");
      Assertion (S2.all = S1.all, "P2: values are unequal");

   exception
      when E : others =>
         Assertion (False, "PX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : TCB.Collection;
      use TCB;
   begin

      Put_Line ("...Bounded tagged Collections");

      Reset (F, Mode => Out_File);
      Append (C1, new Brother'(I => 16#aabb#));
      Append (C1, new Sister'(B => True));
      Append (C2, new Brother'(I => 16#5555#));
      Append (C2, new Sister'(B => False));
      Assertion (C1 /= C2, "TCB1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "TCB2: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "TCBX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : TCD.Collection;
      use TCD;
   begin

      Put_Line ("...Dynamic tagged Collections");

      Reset (F, Mode => Out_File);
      Append (C1, new Brother'(I => 16#aabb#));
      Append (C1, new Sister'(B => True));
      Append (C2, new Brother'(I => 16#5555#));
      Append (C2, new Sister'(B => False));
      Assertion (C1 /= C2, "TCD1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "TCD2: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "TCDX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2 : TCU.Collection;
      use TCU;
   begin

      Put_Line ("...Unbounded tagged Collections");

      Reset (F, Mode => Out_File);
      Append (C1, new Brother'(I => 16#aabb#));
      Append (C1, new Sister'(B => True));
      Append (C2, new Brother'(I => 16#5555#));
      Append (C2, new Sister'(B => False));
      Assertion (C1 /= C2, "TCU1: Collections are equal");
      Collection'Output (Stream (F), C1);
      Reset (F, Mode => In_File);
      C2 := Collection'Input (Stream (F));
      Assertion (C1 = C2, "TCU2: Collections are unequal");

   exception
      when E : others =>
         Assertion (False, "TCUX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   Close (F);

   declare
      C1, C2 : TCU.Collection;
      use TCU;
      Str : aliased BC.Support.Memory_Streams.Stream_Type (78);
   begin

      Put_Line ("...Unbounded tagged Collections to memory stream");

      BC.Support.Memory_Streams.Reset (Str);
      Append (C1, new Brother'(I => 16#aabb#));
      Append (C1, new Sister'(B => True));
      Append (C2, new Brother'(I => 16#5555#));
      Append (C2, new Sister'(B => False));
      Assertion (C1 /= C2, "TCUM1: Collections are equal");
      Collection'Output (Str'Access, C1);
      C2 := Collection'Input (Str'Access);
      Assertion (C1 = C2, "TCUM2: Collections are unequal");
      Put_Line ("buffer length is" &
                  Integer'Image (BC.Support.Memory_Streams.Length (Str)));

   exception
      when E : others =>
         Assertion (False, "TCUMX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   declare
      C1, C2, C3 : TCU.Collection;
      use TCU;
      Str1, Str3 : aliased BC.Support.Memory_Streams.Stream_Type (78);
      Str2 : aliased BC.Support.Memory_Streams.Stream_Type (1024);
   begin

      Put_Line ("...Memory stream to memory stream");

      BC.Support.Memory_Streams.Reset (Str1);
      Append (C1, new Brother'(I => 16#aabb#));
      Append (C1, new Sister'(B => True));
      Append (C2, new Brother'(I => 16#5555#));
      Append (C2, new Sister'(B => False));
      C3 := C2;
      Assertion (C1 /= C2, "TCUM1: Collections are equal");
      Collection'Output (Str1'Access, C1);
      BC.Support.Memory_Streams.Write_Contents (Str2'Access, Str1);
      C2 := Collection'Input (Str2'Access);
      Assertion (C1 = C2, "TCUM2: Collections are unequal");
      Assertion (C1 /= C3, "TCUM3: Collections are equal");
      BC.Support.Memory_Streams.Reset (Str2);
      BC.Support.Memory_Streams.Write_Contents (Str2'Access, Str1);
      BC.Support.Memory_Streams.Read_Contents (Str2'Access, Str3);
      C3 := Collection'Input (Str3'Access);
      Assertion (C1 = C3, "TCUM4: Collections are unequal");
      Put_Line ("first buffer length is" &
                  Integer'Image (BC.Support.Memory_Streams.Length (Str1)));
      Put_Line ("second buffer length is" &
                  Integer'Image (BC.Support.Memory_Streams.Length (Str2)));

   exception
      when E : others =>
         Assertion (False, "TCUMX: Exception occurred");
         Put_Line ("                                   EXCEPTION "
                   & Ada.Exceptions.Exception_Name (E)
                   & " OCCURRED.");
   end;

   Put_Line ("Completed Stream tests");

   Assertions.Report;

exception
   when E : others =>
      Put_Line ("                                   EXCEPTION "
                & Ada.Exceptions.Exception_Name (E)
                & " OCCURRED.");
end Stream_Test;