summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a
blob: c9a007e524f40b0f6a11b1f2216b942ddbe3e906 (plain)
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
-- CXA5011.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, for both Float_Random and Discrete_Random packages,
--      the following are true:
--      1) two objects of type Generator are initialized to the same state.
--      2) when the Function Reset is used to reset two generators
--         to different time-dependent states, the resulting random values
--         from each generator are different.
--      3) when the Function Reset uses the same integer initiator
--         to reset two generators to the same state, the resulting random
--         values from each generator are identical.
--      4) when the Function Reset uses different integer initiator
--         values to reset two generators, the resulting random numbers are
--         different.
--
-- TEST DESCRIPTION:
--      This test evaluates components of the Ada.Numerics.Float_Random and
--      Ada.Numerics.Discrete_Random packages.
--      This test checks to see that objects of type Generator are initialized
--      to the same state. In addition, the functionality of Function Reset is
--      validated.
--      For each of the objectives above, evaluation of the various generators
--      is performed using each of the following techniques. When the states of
--      two generators are to be compared, each state is saved, then
--      transformed to a bounded-string variable.  The bounded-strings can
--      then be compared for equality.  In this case, matching bounded-strings
--      are evidence that the states of two generators are the same.
--      In addition, two generators are compared by evaluating a series of
--      random numbers they produce.  A matching series of random numbers
--      implies that the generators were in the same state prior to producing
--      the numbers.
--
--
-- CHANGE HISTORY:
--      20 Apr 95   SAIC    Initial prerelease version.
--      07 Jul 95   SAIC    Incorporated reviewer comments/suggestions.
--      22 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      17 Aug 96   SAIC    Deleted Subtest #2.
--      09 Feb 01   RLB     Repaired to work on implementations with a 16-bit
--                          Integer.

--!

with Ada.Exceptions;
with Ada.Numerics.Float_Random;
with Ada.Numerics.Discrete_Random;
with Ada.Strings.Bounded;
with ImpDef;
with Report;

procedure CXA5011 is
begin

   Report.Test ("CXA5011", "Check the effect of Function Reset on the " &
                           "state of random number generators");

   Test_Block:
   declare

      use Ada.Exceptions;
      use Ada.Numerics;
      use Ada.Strings.Bounded;

      -- Declare an modular subtype, and use it to instantiate the discrete
      -- random number generator generic package.

      type    Discrete_Range   is mod 2**(Integer'Size-1);
      package Discrete_Package is new Discrete_Random(Discrete_Range);

      -- Declaration of random number generator objects.

      Discrete_Generator_1,
      Discrete_Generator_2  : Discrete_Package.Generator;
      Float_Generator_1,
      Float_Generator_2     : Float_Random.Generator;

      -- Declaration of bounded string packages instantiated with the
      -- value of Max_Image_Width constant from each random number generator
      -- package, and bounded string variables used to hold the image of
      -- random number generator states.

      package Discrete_String_Pack is
        new Generic_Bounded_Length(Discrete_Package.Max_Image_Width);

      package Float_String_Pack is
        new Generic_Bounded_Length(Float_Random.Max_Image_Width);

      use Discrete_String_Pack, Float_String_Pack;

      TC_Seed                  : Integer;
      TC_Max_Loop_Count        : constant Natural := 1000;
      Allowed_Matches          : constant Natural := 2;
      --
      -- In a sequence of TC_Max_Loop_Count random numbers that should
      -- not match, some may match by chance.  Up to Allowed_Matches
      -- numbers may match before the test is considered to fail.
      --


      procedure Check_Float_State (Gen_1, Gen_2 : Float_Random.Generator;
                                   Sub_Test     : Integer;
                                   States_Should_Match : Boolean) is

         use type Float_Random.State;

         State_1,
         State_2         : Float_Random.State;

         State_String_1,
         State_String_2  : Float_String_Pack.Bounded_String :=
                             Float_String_Pack.Null_Bounded_String;
      begin

         Float_Random.Save(Gen => Gen_1, To_State => State_1);
         Float_Random.Save(Gen_2, State_2);

         State_String_1 :=
           Float_String_Pack.To_Bounded_String(Source =>
             Float_Random.Image(Of_State => State_1));

         State_String_2 :=
           Float_String_Pack.To_Bounded_String(Float_Random.Image(State_2));

         case States_Should_Match is
            when True  =>
               if State_1 /= State_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)    &
                                "   State values from Float generators " &
                                "are not the same");
               end if;
               if State_String_1 /= State_String_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)     &
                                "   State strings from Float generators " &
                                "are not the same");
               end if;
            when False =>
               if State_1 = State_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)    &
                                "   State values from Float generators " &
                                "are the same");
               end if;
               if State_String_1 = State_String_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)     &
                                "   State strings from Float generators " &
                                "are the same");
               end if;
         end case;
      end Check_Float_State;



      procedure Check_Discrete_State (Gen_1,
                                      Gen_2    : Discrete_Package.Generator;
                                      Sub_Test : Integer;
                                      States_Should_Match : Boolean) is

         use type Discrete_Package.State;

         State_1, State_2  : Discrete_Package.State;

         State_String_1,
         State_String_2    : Discrete_String_Pack.Bounded_String :=
                               Discrete_String_Pack.Null_Bounded_String;
      begin

         Discrete_Package.Save(Gen      => Gen_1,
                               To_State => State_1);
         Discrete_Package.Save(Gen_2, To_State => State_2);

         State_String_1 :=
           Discrete_String_Pack.To_Bounded_String(Source =>
             Discrete_Package.Image(Of_State => State_1));

         State_String_2 :=
           Discrete_String_Pack.To_Bounded_String(Source =>
             Discrete_Package.Image(Of_State => State_2));

         case States_Should_Match is
            when True  =>
               if State_1 /= State_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
                                "   State values from Discrete "      &
                                "generators are not the same");
               end if;
               if State_String_1 /= State_String_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
                                "   State strings from Discrete "     &
                                "generators are not the same");
               end if;
            when False =>
               if State_1 = State_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
                                "   State values from Discrete "      &
                                "generators are the same");
               end if;
               if State_String_1 = State_String_2 then
                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
                                "   State strings from Discrete "     &
                                "generators are the same");
               end if;
         end case;
      end Check_Discrete_State;



      procedure Check_Float_Values (Gen_1, Gen_2 : Float_Random.Generator;
                                    Sub_Test     : Integer;
                                    Values_Should_Match : Boolean) is
         Matches         : Natural := 0;
         Check_Failed    : Boolean := False;
      begin
         case Values_Should_Match is
            when True  =>
               for i in 1..TC_Max_Loop_Count loop
                  if Float_Random.Random(Gen_1) /= Float_Random.Random(Gen_2)
                  then
                     Check_Failed := True;
                     exit;
                  end if;
               end loop;
               if Check_Failed then
                  Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
                                "   Random numbers from Float generators " &
                                "Failed check");
               end if;
            when False =>
               for i in 1..TC_Max_Loop_Count loop
                  if Float_Random.Random(Gen_1) = Float_Random.Random(Gen_2)
                  then
                     Matches := Matches + 1;
                  end if;
               end loop;
         end case;

         if (Values_Should_Match and Check_Failed) or
            (not Values_Should_Match and Matches > Allowed_Matches)
         then
            Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
                          "   Random numbers from Float generators " &
                          "Failed check");
         end if;

      end Check_Float_Values;



      procedure Check_Discrete_Values (Gen_1,
                                       Gen_2    : Discrete_Package.Generator;
                                       Sub_Test : Integer;
                                       Values_Should_Match : Boolean) is
         Matches         : Natural := 0;
         Check_Failed    : Boolean := False;
      begin
         case Values_Should_Match is
            when True  =>
               for i in 1..TC_Max_Loop_Count loop
                  if Discrete_Package.Random(Gen_1) /=
                     Discrete_Package.Random(Gen_2)
                  then
                     Check_Failed := True;
                     exit;
                  end if;
               end loop;
            when False =>
               for i in 1..TC_Max_Loop_Count loop
                  if Discrete_Package.Random(Gen_1) =
                     Discrete_Package.Random(Gen_2)
                  then
                     Matches := Matches + 1;
                  end if;
               end loop;
         end case;

         if (Values_Should_Match and Check_Failed) or
            (not Values_Should_Match and Matches > Allowed_Matches)
         then
            Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
                          "   Random numbers from Discrete generators " &
                          "Failed check");
         end if;

      end Check_Discrete_Values;



   begin

      Sub_Test_1:
         -- Check that two objects of type Generator are initialized to the
         -- same state.
      begin

         -- Since the discrete and float random generators are in the initial
         -- state, using Procedure Save to save the states of the generator
         -- objects, and transforming these states into strings using
         -- Function Image, should yield identical strings.

         Check_Discrete_State (Discrete_Generator_1,
                               Discrete_Generator_2,
                               Sub_Test => 1,
                               States_Should_Match => True);

         Check_Float_State (Float_Generator_1,
                            Float_Generator_2,
                            Sub_Test => 1,
                            States_Should_Match => True);

         -- Since the two random generator objects are in their initial
         -- state, the values produced from each (upon calls to Random)
         -- should be identical.

         Check_Discrete_Values (Discrete_Generator_1,
                                Discrete_Generator_2,
                                Sub_Test => 1,
                                Values_Should_Match => True);

         Check_Float_Values (Float_Generator_1,
                             Float_Generator_2,
                             Sub_Test => 1,
                             Values_Should_Match => True);

      end Sub_Test_1;



      Sub_Test_3:
         -- Check that when the Function Reset uses the same integer
         -- initiator to reset two generators to the same state, the
         -- resulting random values and the state from each generator
         -- are identical.
      declare
         use Discrete_Package, Float_Random;
      begin

         -- Reset the generators to the same states, using the version of
         -- Function Reset with both generator parameter and initiator
         -- specified.

         TC_Seed := Integer(Random(Discrete_Generator_1));
         Reset(Gen => Discrete_Generator_1, Initiator => TC_Seed);
         Reset(Discrete_Generator_2, Initiator => TC_Seed);
         Reset(Float_Generator_1, TC_Seed);
         Reset(Float_Generator_2, TC_Seed);

         -- Since the random generators have been reset to identical states,
         -- bounded string images of these states should yield identical
         -- strings.

         Check_Discrete_State (Discrete_Generator_1,
                               Discrete_Generator_2,
                               Sub_Test => 3,
                               States_Should_Match => True);

         Check_Float_State (Float_Generator_1,
                            Float_Generator_2,
                            Sub_Test => 3,
                            States_Should_Match => True);

         -- Since the random generators have been reset to identical states,
         -- the values produced from each (upon calls to Random) should
         -- be identical.

         Check_Discrete_Values (Discrete_Generator_1,
                                Discrete_Generator_2,
                                Sub_Test => 3,
                                Values_Should_Match => True);

         Check_Float_Values (Float_Generator_1,
                             Float_Generator_2,
                             Sub_Test => 3,
                             Values_Should_Match => True);

      end Sub_Test_3;



      Sub_Test_4:
         -- Check that when the Function Reset uses different integer
         -- initiator values to reset two generators, the resulting random
         -- numbers and states are different.
      begin

         -- Reset the generators to different states.

         TC_Seed :=
           Integer(Discrete_Package.Random(Discrete_Generator_1));

         Discrete_Package.Reset(Gen       => Discrete_Generator_1,
                                Initiator => TC_Seed);

         -- Set the seed value to a different value for the second call
         -- to Reset.
         -- Note: A second call to Random could be made, as above, but that
         --       would not ensure that the resulting seed value was
         --       different from the first.

         if TC_Seed /= Integer'Last then
            TC_Seed := TC_Seed + 1;
         else
            TC_Seed := TC_Seed - 1;
         end if;

         Discrete_Package.Reset(Gen       => Discrete_Generator_2,
                                Initiator => TC_Seed);

         Float_Random.Reset(Float_Generator_1, 16#FF#);             -- 255
         Float_Random.Reset(Float_Generator_2, 2#1110_0000#);       -- 224

         -- Since the two float random generators are in different
         -- states, the bounded string images depicting their states should
         -- differ.

         Check_Discrete_State (Discrete_Generator_1,
                               Discrete_Generator_2,
                               Sub_Test => 4,
                               States_Should_Match => False);

         Check_Float_State (Float_Generator_1,
                            Float_Generator_2,
                            Sub_Test => 4,
                            States_Should_Match => False);

         -- Since the two discrete random generator objects were reset
         -- to different states, the values produced from each (upon calls
         -- to Random) should differ.

         Check_Discrete_Values (Discrete_Generator_1,
                                Discrete_Generator_2,
                                Sub_Test => 4,
                                Values_Should_Match => False);

         Check_Float_Values (Float_Generator_1,
                             Float_Generator_2,
                             Sub_Test => 4,
                             Values_Should_Match => False);

      end Sub_Test_4;

   exception
      when The_Error : others =>
         Report.Failed ("The following exception was raised in the " &
                        "Test_Block: " & Exception_Name(The_Error));
   end Test_Block;

   Report.Result;

end CXA5011;