Task safe random generation

U503-007

* src/core/aws-utils.adb
(Shared_Random): Object to protect random number generator from multi task
 concurrency.
(Random_Reset): New routine to initate predictable random sequence.

* regtests/0336_random_task_safe/test.adb,
  regtests/0336_random_task_safe/test.gpr,
  regtests/0336_random_task_safe/test.py:
Test for random generation concurrency.

regtests/0336_random_task_safe/test.adb

@@ -0,0 +1,119 @@
+with Ada.Containers.Hashed_Sets;
+
+with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Text_IO;    use Ada.Text_IO;
+with AWS.Utils;      use AWS.Utils;
+
+procedure Test is
+
+   type Test_Random_Mode is (None, Save, Lookup);
+
+   package Random_Sets is new Ada.Containers.Hashed_Sets
+     (Random_Integer, Ada.Containers.Hash_Type'Mod, "=");
+
+   Set : Random_Sets.Set;
+   Locker : RW_Semaphore (1);
+   Wrong_Data_Set : exception;
+
+   procedure Test_Random_Sequence
+     (Count : Positive; Mode : Test_Random_Mode);
+
+   function Test_Random_Sequence
+     (Initialor : Integer; Count : Positive) return String;
+
+   task Secondary is
+      entry Start (Count : Positive; Mode : Test_Random_Mode);
+      entry Done (Quit : Boolean);
+   end Secondary;
+
+   --------------------------
+   -- Test_Random_Sequence --
+   --------------------------
+
+   function Test_Random_Sequence
+     (Initialor : Integer; Count : Positive) return String is
+   begin
+      Random_Reset (Initialor);
+      Test_Random_Sequence (Count, None);
+      return Random_String (77);
+   end Test_Random_Sequence;
+
+   procedure Test_Random_Sequence
+     (Count : Positive; Mode : Test_Random_Mode)
+   is
+      R : Random_Integer;
+   begin
+      for J in 1 .. Count loop
+         R := Random;
+
+         case Mode is
+            when None =>
+               null;
+
+            when Save =>
+               Locker.Write;
+               Set.Include (R);
+               Locker.Release_Write;
+
+            when Lookup =>
+               if not Set.Contains (R) then
+                  raise Wrong_Data_Set with
+                    "Expected random element" & R'Img & " absent at" & J'Img;
+               end if;
+         end case;
+      end loop;
+
+   end Test_Random_Sequence;
+
+   ---------------
+   -- Secondary --
+   ---------------
+
+   task body Secondary is
+      Count : Positive;
+      Mode  : Test_Random_Mode;
+      Quit  : Boolean;
+   begin
+      loop
+         accept Start (Count : Positive; Mode  : Test_Random_Mode) do
+            Secondary.Count := Count;
+            Secondary.Mode  := Mode;
+         end Start;
+
+         Test_Random_Sequence (Count, Mode);
+
+         accept Done (Quit : Boolean) do
+            Secondary.Quit := Quit;
+         end Done;
+
+         exit when Quit;
+      end loop;
+
+   exception
+      when E : others =>
+         Put_Line ("Secondary task: " & Exception_Message (E));
+   end Secondary;
+
+begin
+   if Test_Random_Sequence (321, 256) /= Test_Random_Sequence (321, 256) then
+      Put_Line ("Random_Reset with same initialor error");
+   end if;
+
+   for Mode in Save .. Lookup loop
+      Random_Reset (112344);
+      Test_Random_Sequence (4096, Mode);
+   end loop;
+
+   Set.Clear;
+
+   for Mode in Save .. Lookup loop
+      Random_Reset (44552211);
+      Secondary.Start (8196, Mode);
+      Test_Random_Sequence (8196, Mode);
+      Secondary.Done (Mode = Lookup);
+   end loop;
+
+exception
+   when E : others =>
+      Put_Line ("Main task: " & Exception_Message (E));
+end Test;

regtests/0336_random_task_safe/test.gpr

@@ -0,0 +1,5 @@
+with "aws.gpr";
+
+project Test is
+    for Main use ("test.adb");
+end Test;

regtests/0336_random_task_safe/test.py

@@ -0,0 +1,3 @@
+from test_support import *
+
+build_and_run('test');

src/core/aws-net-websocket-protocol-rfc6455.adb

@@ -130,7 +130,7 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is
    is
       pragma Unreferenced (Protocol);
       Ints : array (1 .. 4) of AWS.Utils.Random_Integer :=
-              (others => AWS.Utils.Random);
+               (others => Utils.Random);
       H : Stream_Element_Array (1 .. 16) with Import, Address => Ints'Address;
 
    begin
@@ -183,7 +183,7 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is
    ------------------------
 
    function Create_Random_Mask return Masking_Key is
-      Int : constant AWS.Utils.Random_Integer := AWS.Utils.Random;
+      Int : constant Utils.Random_Integer := Utils.Random;
       Arr : Masking_Key with Import, Address => Int'Address;
    begin
       return Arr;

src/core/aws-utils.adb

@@ -68,7 +68,13 @@ package body AWS.Utils is
    --  Returns True if the string pointed to by Str and terminating to Last
    --  is well-formed UTF-8.
 
-   Random_Generator : Integer_Random.Generator;
+   protected Shared_Random is
+      function Generate return Random_Integer;
+      procedure Reset;
+      procedure Reset (Seed : Integer);
+   private
+      Random_Generator : Integer_Random.Generator;
+   end Shared_Random;
 
    ---------------------
    -- Append_With_Sep --
@@ -885,9 +891,18 @@ package body AWS.Utils is
 
    function Random return Random_Integer is
    begin
-      return Integer_Random.Random (Random_Generator);
+      return Shared_Random.Generate;
    end Random;
 
+   ------------------
+   -- Random_Reset --
+   ------------------
+
+   procedure Random_Reset (Seed : Integer) is
+   begin
+      Shared_Random.Reset (Seed);
+   end Random_Reset;
+
    -------------------
    -- Random_String --
    -------------------
@@ -1003,6 +1018,37 @@ package body AWS.Utils is
 
    end Semaphore;
 
+   -------------------
+   -- Shared_Random --
+   -------------------
+
+   protected body Shared_Random is
+
+      --------------
+      -- Generate --
+      --------------
+
+      function Generate return Random_Integer is
+      begin
+         return Integer_Random.Random (Random_Generator);
+      end Generate;
+
+      -----------
+      -- Reset --
+      -----------
+
+      procedure Reset is
+      begin
+         Integer_Random.Reset (Random_Generator);
+      end Reset;
+
+      procedure Reset (Seed : Integer) is
+      begin
+         Integer_Random.Reset (Random_Generator, Seed);
+      end Reset;
+
+   end Shared_Random;
+
    -----------------------
    -- Significant_Image --
    -----------------------
@@ -1159,5 +1205,5 @@ package body AWS.Utils is
    end Time_Zone;
 
 begin
-   Integer_Random.Reset (Random_Generator);
+   Shared_Random.Reset;
 end AWS.Utils;

src/core/aws-utils.ads

@@ -94,6 +94,12 @@ package AWS.Utils is
                          => C in '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z');
    --  Returns random string
 
+   procedure Random_Reset (Seed : Integer);
+   --  This function is needed only if the user wants to get predictable random
+   --  numbers. It means that after calling Random_Reset with the same Seed the
+   --  same sequence of Random and Random_String calls will give the same
+   --  results.
+
    function Image (N : Natural) return String with
      Post => Image'Result'Length > 0
              and then Image'Result (Image'Result'First) /= ' ';