-- 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;