-- CXA5013.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that a discrete random number generator will yield each value
-- in its result subtype in a finite number of calls, provided that
-- the number of such values does not exceed 2**15.
--
-- TEST DESCRIPTION:
-- This test demonstrates certain capabilities of the random number
-- generator packages in Ada.Numerics. A generic subprogram is
-- defined that will be instantiated to produce a total of two test
-- subprograms.
-- The area examined by this test is the production of random values
-- over a discrete range. A generic procedure is instantiated with
-- an instance of the Discrete_Random package, once for an integer type,
-- and once for an enumeration type. The test procedure performs a
-- test run, generating a specific number of random numbers over the
-- range of the type. If this run did not generate each of the values
-- in the type range, an asynchronous select statement is invoked. This
-- select statement has a trigger statement delay for a specific
-- (implementation defined) amount of time during which additional test
-- runs will be performed.
-- At the end of each run in this test, an evaluation is made to
-- determine if each value in the range of possible values have been
-- generated. At the conclusion of the runs, or if the specified test
-- delay time expires, the test is concluded with a status value
-- returned from the test procedure. An implementation is given three
-- completely separate opportunities to run the test successfully, and
-- if at the conclusion of all of these tests no successful result has
-- been returned, the test is considered failed.
--
--
-- CHANGE HISTORY:
-- 27 Apr 95 SAIC Initial prerelease version.
--
--!
with Ada.Numerics.Discrete_Random;
with ImpDef;
with Report;
procedure CXA5013 is
begin
Report.Test ("CXA5013", "Check that a discrete random number generator " &
"will yield each value in its result subtype " &
"in a finite number of calls");
Test_Block:
declare
use Ada.Numerics;
-- The following constant designed into the test creates a high
-- probability that a random series of numbers will satisfy the
-- requirements. Occasionally, even a random series of numbers
-- will fail. In such a case, the test will reset the random
-- number generator and rerun the test conditions. This constant
-- determines how many times the random number generator will be
-- reset before any individual test run is failed.
TC_Max_Random_Test_Runs : constant := 3;
-- The following constant will ensure that multiple attempts of the
-- complete set of tests are performed in the event of a failure of
-- a set of test runs.
TC_Finite_Number_Of_Tests : constant := 3;
TC_Test_Run : Integer := 0;
TC_Success : Boolean := False;
TC_Trials_Per_Test : Integer := 1500;
type Enum_Type is (One, Two, Three, Four, Five, Six, Seven);
type Discrete_Type is range 1..100;
package Enum_Pack is new Discrete_Random(Enum_Type);
package Discrete_Pack is
new Discrete_Random(Result_Subtype => Discrete_Type);
--
-- Definition of generic Random_Test procedure, which will be
-- instantiated for both an integer type and an enumeration type.
--
generic
with package Gen_Pack is new Ada.Numerics.Discrete_Random (<>);
procedure Random_Test (Trials_Per_Test : in Integer;
Success : out Boolean);
procedure Random_Test (Trials_Per_Test : in Integer;
Success : out Boolean) is
Total_Runs : Integer := 0;
Total_Trials : Integer := 0;
Total_Attempts_This_Test : Integer := 0;
Random_Array : array (Gen_Pack.Result_Subtype)
of Boolean := (others => False);
Gen : Gen_Pack.Generator;
function All_Values_Present return Boolean is
Result : Boolean := True;
begin
for i in Gen_Pack.Result_Subtype'Range loop
if not Random_Array(i) then
Result := False;
exit;
end if;
end loop;
return Result;
end All_Values_Present;
begin
Success := False; -- Initialized to failure prior to test.
Gen_Pack.Reset(Gen); -- Perform a time-dependent reset.
-- Guarantee that a specific minimum number of trials are performed
-- prior to the timer being set.
for i in 1..Trials_Per_Test loop
-- Set array element to True when a particular array
-- index is generated by the random number generator.
Random_Array(Gen_Pack.Random(Gen)) := True;
end loop;
if All_Values_Present then
Success := True; -- Test was successful, exit procedure with no
-- further testing performed.
else
-- Initial test above was unsuccessful, so set a timer and perform
-- additional trials to determine if all values in the discrete
-- range will be produced.
select
-- This asynchronous select has a triggering statement which
-- is a delay statement, set to an implementation defined
-- number of seconds for any particular test to execute.
-- The point here is to allow the implementation to decide
-- how long to run this test in order to generate an
-- appropriate (i.e., correct) sample from the Random Number
-- Generator.
delay ImpDef.Delay_Per_Random_Test; -- Delay per test.
-- If, after expiration of delay, the random number generator
-- has generated all values within the range at least once,
-- then the result is success; otherwise, a comment is output
-- to indicate that the random number generator was
-- unsuccessful in this series of test runs.
if All_Values_Present then
Success := True;
else
Total_Attempts_This_Test :=
Total_Runs * Trials_Per_Test + Total_Trials;
Report.Comment
("Not all numbers within the Range were produced in " &
Integer'Image(
Integer(ImpDef.Delay_Per_Random_Test*1000.0)) &
" milliseconds or in " &
Integer'Image(Total_Attempts_This_Test) &
" trials during this test");
end if;
then abort
-- After setting the triggering statement above, the execution
-- of this abortable part is begun.
-- This loop continues until either a) every value has been
-- produced or b) the triggering statement times out.
Total_Runs := 1;
Test_Loop: -- This loop continues until a test run is
loop -- successful, the test run limit has been reached,
-- or the triggering statement times-out above.
Total_Trials := 0;
for i in 1..Trials_Per_Test loop
Total_Trials := i; -- Used above if triggering statement
-- completes prior to test completion.
-- Set array element to True when a particular array
-- index is generated by the random number generator.
Random_Array(Gen_Pack.Random(Gen)) := True;
end loop;
-- At the conclusion of a complete series of trials, the
-- following evaluation is performed to determine whether
-- the test run was successful, or whether an additional
-- test run should be re-attempted.
if All_Values_Present then
Success := True;
exit Test_Loop;
elsif Total_Runs = TC_Max_Random_Test_Runs then
Report.Comment
("Not all numbers in the Range were produced in " &
Integer'Image(Total_Runs*Trials_Per_Test) &
" individual trials during this test");
exit Test_Loop;
else
Total_Runs := Total_Runs + 1;
end if;
end loop Test_Loop;
end select;
end if;
end Random_Test;
-- Instantiation of test procedures.
procedure Discrete_Random_Test is new Random_Test(Discrete_Pack);
procedure Enumeration_Random_Test is new Random_Test(Enum_Pack);
begin
-- Make a series of test runs, checking to ensure that discrete
-- random number generators produce each value in their result subtype
-- within a finite number of calls. In each case, if the first test
-- is not successful, another attempt is made, after a time-dependent
-- reset, up to a total of 3 runs. This allows an implementation
-- multiple opportunities to pass the test successfully.
-- Note: The odds of getting all 100 integer values in 1500 trials are
-- greater than 99.997 percent, confirmed by Monte Carlo
-- simulation.
-- Run the Random_Test for an integer discrete random number generator.
TC_Test_Run := 0;
TC_Success := False;
while TC_Test_Run < TC_Finite_Number_Of_Tests and
not TC_Success
loop
TC_Test_Run := TC_Test_Run + 1; -- Increment test counter.
Discrete_Random_Test (TC_Trials_Per_Test, -- Perform test.
TC_Success);
-- Increment the number of trials that will be performed
-- in the next test by 50%.
TC_Trials_Per_Test := TC_Trials_Per_Test + TC_Trials_Per_Test/2 ;
end loop;
if not TC_Success then
Report.Failed("Random_Test was run " & Integer'Image(TC_Test_Run) &
" times, but a successful result was not recorded " &
"from any run using the integer discrete random " &
"number generator");
end if;
-- Run the Random_Test for an enumeration type random number generator.
-- Note: The odds of getting all seven enumeration values in 100
-- trials are greater than 99.997 percent, confirmed by Monte
-- Carlo simulation.
TC_Test_Run := 0;
TC_Trials_Per_Test := 100;
TC_Success := False;
while TC_Test_Run < TC_Finite_Number_Of_Tests and
not TC_Success
loop
TC_Test_Run := TC_Test_Run + 1;
Enumeration_Random_Test (TC_Trials_Per_Test,
TC_Success);
-- Increment the number of trials that will be performed
-- in the next test by 50%.
TC_Trials_Per_Test := TC_Trials_Per_Test + TC_Trials_Per_Test/2 ;
end loop;
if not TC_Success then
Report.Failed("Random_Test was run " & Integer'Image(TC_Test_Run) &
" times, but a successful result was not recorded " &
"from any run using the enumeration random number " &
"generator");
end if;
exception
when others => Report.Failed ("Exception raised in Test_Block");
end Test_Block;
Report.Result;
end CXA5013;