Skip to content

Commit d4557da

Browse files
committed
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.
1 parent ea2fd48 commit d4557da

File tree

6 files changed

+184
-5
lines changed

6 files changed

+184
-5
lines changed
Lines changed: 119 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,119 @@
1+
with Ada.Containers.Hashed_Sets;
2+
3+
with Ada.Exceptions; use Ada.Exceptions;
4+
with Ada.Text_IO; use Ada.Text_IO;
5+
with AWS.Utils; use AWS.Utils;
6+
7+
procedure Test is
8+
9+
type Test_Random_Mode is (None, Save, Lookup);
10+
11+
package Random_Sets is new Ada.Containers.Hashed_Sets
12+
(Random_Integer, Ada.Containers.Hash_Type'Mod, "=");
13+
14+
Set : Random_Sets.Set;
15+
Locker : RW_Semaphore (1);
16+
Wrong_Data_Set : exception;
17+
18+
procedure Test_Random_Sequence
19+
(Count : Positive; Mode : Test_Random_Mode);
20+
21+
function Test_Random_Sequence
22+
(Initialor : Integer; Count : Positive) return String;
23+
24+
task Secondary is
25+
entry Start (Count : Positive; Mode : Test_Random_Mode);
26+
entry Done (Quit : Boolean);
27+
end Secondary;
28+
29+
--------------------------
30+
-- Test_Random_Sequence --
31+
--------------------------
32+
33+
function Test_Random_Sequence
34+
(Initialor : Integer; Count : Positive) return String is
35+
begin
36+
Random_Reset (Initialor);
37+
Test_Random_Sequence (Count, None);
38+
return Random_String (77);
39+
end Test_Random_Sequence;
40+
41+
procedure Test_Random_Sequence
42+
(Count : Positive; Mode : Test_Random_Mode)
43+
is
44+
R : Random_Integer;
45+
begin
46+
for J in 1 .. Count loop
47+
R := Random;
48+
49+
case Mode is
50+
when None =>
51+
null;
52+
53+
when Save =>
54+
Locker.Write;
55+
Set.Include (R);
56+
Locker.Release_Write;
57+
58+
when Lookup =>
59+
if not Set.Contains (R) then
60+
raise Wrong_Data_Set with
61+
"Expected random element" & R'Img & " absent at" & J'Img;
62+
end if;
63+
end case;
64+
end loop;
65+
66+
end Test_Random_Sequence;
67+
68+
---------------
69+
-- Secondary --
70+
---------------
71+
72+
task body Secondary is
73+
Count : Positive;
74+
Mode : Test_Random_Mode;
75+
Quit : Boolean;
76+
begin
77+
loop
78+
accept Start (Count : Positive; Mode : Test_Random_Mode) do
79+
Secondary.Count := Count;
80+
Secondary.Mode := Mode;
81+
end Start;
82+
83+
Test_Random_Sequence (Count, Mode);
84+
85+
accept Done (Quit : Boolean) do
86+
Secondary.Quit := Quit;
87+
end Done;
88+
89+
exit when Quit;
90+
end loop;
91+
92+
exception
93+
when E : others =>
94+
Put_Line ("Secondary task: " & Exception_Message (E));
95+
end Secondary;
96+
97+
begin
98+
if Test_Random_Sequence (321, 256) /= Test_Random_Sequence (321, 256) then
99+
Put_Line ("Random_Reset with same initialor error");
100+
end if;
101+
102+
for Mode in Save .. Lookup loop
103+
Random_Reset (112344);
104+
Test_Random_Sequence (4096, Mode);
105+
end loop;
106+
107+
Set.Clear;
108+
109+
for Mode in Save .. Lookup loop
110+
Random_Reset (44552211);
111+
Secondary.Start (8196, Mode);
112+
Test_Random_Sequence (8196, Mode);
113+
Secondary.Done (Mode = Lookup);
114+
end loop;
115+
116+
exception
117+
when E : others =>
118+
Put_Line ("Main task: " & Exception_Message (E));
119+
end Test;
Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
with "aws.gpr";
2+
3+
project Test is
4+
for Main use ("test.adb");
5+
end Test;
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
from test_support import *
2+
3+
build_and_run('test');

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -130,7 +130,7 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is
130130
is
131131
pragma Unreferenced (Protocol);
132132
Ints : array (1 .. 4) of AWS.Utils.Random_Integer :=
133-
(others => AWS.Utils.Random);
133+
(others => Utils.Random);
134134
H : Stream_Element_Array (1 .. 16) with Import, Address => Ints'Address;
135135

136136
begin
@@ -183,7 +183,7 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is
183183
------------------------
184184

185185
function Create_Random_Mask return Masking_Key is
186-
Int : constant AWS.Utils.Random_Integer := AWS.Utils.Random;
186+
Int : constant Utils.Random_Integer := Utils.Random;
187187
Arr : Masking_Key with Import, Address => Int'Address;
188188
begin
189189
return Arr;

src/core/aws-utils.adb

Lines changed: 49 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,13 @@ package body AWS.Utils is
6868
-- Returns True if the string pointed to by Str and terminating to Last
6969
-- is well-formed UTF-8.
7070

71-
Random_Generator : Integer_Random.Generator;
71+
protected Shared_Random is
72+
function Generate return Random_Integer;
73+
procedure Reset;
74+
procedure Reset (Seed : Integer);
75+
private
76+
Random_Generator : Integer_Random.Generator;
77+
end Shared_Random;
7278

7379
---------------------
7480
-- Append_With_Sep --
@@ -885,9 +891,18 @@ package body AWS.Utils is
885891

886892
function Random return Random_Integer is
887893
begin
888-
return Integer_Random.Random (Random_Generator);
894+
return Shared_Random.Generate;
889895
end Random;
890896

897+
------------------
898+
-- Random_Reset --
899+
------------------
900+
901+
procedure Random_Reset (Seed : Integer) is
902+
begin
903+
Shared_Random.Reset (Seed);
904+
end Random_Reset;
905+
891906
-------------------
892907
-- Random_String --
893908
-------------------
@@ -1003,6 +1018,37 @@ package body AWS.Utils is
10031018

10041019
end Semaphore;
10051020

1021+
-------------------
1022+
-- Shared_Random --
1023+
-------------------
1024+
1025+
protected body Shared_Random is
1026+
1027+
--------------
1028+
-- Generate --
1029+
--------------
1030+
1031+
function Generate return Random_Integer is
1032+
begin
1033+
return Integer_Random.Random (Random_Generator);
1034+
end Generate;
1035+
1036+
-----------
1037+
-- Reset --
1038+
-----------
1039+
1040+
procedure Reset is
1041+
begin
1042+
Integer_Random.Reset (Random_Generator);
1043+
end Reset;
1044+
1045+
procedure Reset (Seed : Integer) is
1046+
begin
1047+
Integer_Random.Reset (Random_Generator, Seed);
1048+
end Reset;
1049+
1050+
end Shared_Random;
1051+
10061052
-----------------------
10071053
-- Significant_Image --
10081054
-----------------------
@@ -1159,5 +1205,5 @@ package body AWS.Utils is
11591205
end Time_Zone;
11601206

11611207
begin
1162-
Integer_Random.Reset (Random_Generator);
1208+
Shared_Random.Reset;
11631209
end AWS.Utils;

src/core/aws-utils.ads

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,12 @@ package AWS.Utils is
9494
=> C in '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z');
9595
-- Returns random string
9696

97+
procedure Random_Reset (Seed : Integer);
98+
-- This function is needed only if the user wants to get predictable random
99+
-- numbers. It means that after calling Random_Reset with the same Seed the
100+
-- same sequence of Random and Random_String calls will give the same
101+
-- results.
102+
97103
function Image (N : Natural) return String with
98104
Post => Image'Result'Length > 0
99105
and then Image'Result (Image'Result'First) /= ' ';

0 commit comments

Comments
 (0)