path: root/gcc/testsuite/ada/acats-2/tests/cxa/cxa5013.a

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