stephes_ada_library_3.7.3_08b48307/test/test_randomize_lists.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
--  Abstract :
--
--  See spec.
--
--  Copyright (C) 2009, 2012, 2015, 2018 Stephen Leake.  All Rights Reserved.
--
--  This program 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. This program 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 program; see file COPYING. If not, write to
--  the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
--  MA 02111-1307, USA.

pragma License (GPL);
with AUnit.Checks;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Text_IO;
with SAL.Gen_Randomize_Doubly_Linked_Lists;
package body Test_Randomize_Lists is

   type Integer_Array_Type is array (Positive range <>) of Integer;

   package Lists is new Ada.Containers.Doubly_Linked_Lists (Integer);

   procedure Check
     (Label    : in String;
      Computed : in Lists.List;
      Expected : in Integer_Array_Type)
   is
      use AUnit.Checks;
      use Lists;

      J : Cursor := First (Computed);
   begin
      Check (Label & " count", Integer (Computed.Length), Expected'Length);

      for I in Expected'Range loop
         Check (Label & Integer'Image (I), Element (J), Expected (I));
         Next (J);
      end loop;
   exception
   when others =>
      --  Assume failed due to new compiler; display computed
      Ada.Text_IO.Put ("(");
      for I of Computed loop
         Ada.Text_IO.Put (Integer'Image (I) & ",");
      end loop;
      Ada.Text_IO.Put_Line (")");
      raise;
   end Check;

   ----------
   --  Test procedures

   procedure Randomize (T : in out AUnit.Test_Cases.Test_Case'Class)
   is
      pragma Unreferenced (T);

      use Lists;

      procedure Randomize is new SAL.Gen_Randomize_Doubly_Linked_Lists (Lists);

      List : Lists.List;
   begin
      for I in 1 .. 20 loop
         List.Append (I);
      end loop;

      Randomize (List, Seed => 0);

      --  Result is empirical, and could change with each new version
      --  of the compiler, if it changes the Random implementation.
      --  Correct for GNAT GPL 2014
      Check ("random", List, (10, 1, 11, 2, 14, 6, 20, 3, 9, 16, 13, 5, 17, 15, 18, 19, 7, 4, 8, 12));

   end Randomize;

   ----------
   --  Public routines

   overriding procedure Register_Tests (T : in out Test_Case)
   is
      use AUnit.Test_Cases.Registration;
   begin
      Register_Routine (T, Randomize'Access, "Randomize");
   end Register_Tests;

   overriding function Name (T : Test_Case) return AUnit.Message_String
   is
      pragma Unreferenced (T);
   begin
      return new String'("../../test/test_randomize_lists.adb");
   end Name;

end Test_Randomize_Lists;