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 | with Ada.Exceptions; use Ada.Exceptions;
with Ada.Real_Time; use Ada.Real_Time;
with Ada.Task_Identification;
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.Refcount;
with Test_Assert; use Test_Assert;
function Test return Integer is
package Shared_Holders is new GNATCOLL.Refcount.Shared_Pointers (Integer);
use Shared_Holders;
task type Weak_Tester is
entry Take (Ptr : Ref);
entry Stop;
end Weak_Tester;
-- This test runs three ref-to-weak and then weak-to-ref patterns in loops
-- concurrently to check that both conversions are resilient to concurrent
-- inc-ref/dec-ref operations.
--
-- This is an attempt to check that there is no race condition between
-- ref-counting drop to 0 happens and a weak-to-ref conversion.
--
-- The structure of this test is the following:
--
-- * Some code runs a weak-to-ref conversion at most Task_Inner_Range
-- times, stopping as soon as the conversion returns a null reference.
--
-- * Run three tasks (Weak_Tester) run that code Task_Outer_Range times.
--
-- We expect race conditions to somehow make the weak-to-ref conversion
-- produce a stale reference (which is invalid), so that dereferencing it
-- would yield an unexpected number.
subtype Task_Outer_Range is Positive range 1 .. 20_000;
subtype Task_Inner_Range is Natural;
Notification_Interval : constant Positive := 10_000;
task body Weak_Tester is
Stop_It : Boolean := False;
W : Weak_Ref;
begin
Main_Loop : for J in Task_Outer_Range loop
declare
R : Ref;
begin
select
accept Take (Ptr : Ref) do
R := Ptr;
end Take;
or
accept Stop do
Stop_It := True;
end Stop;
end select;
W := R.Weak;
end;
exit Main_Loop when Stop_It;
for K in Task_Inner_Range'Range loop
declare
use Ada.Task_Identification;
R : Ref;
begin
R.Set (W);
if R = Null_Ref then
if K = 0 then
Put_Line
("Taken null at first time " & J'Img & ' '
& Image (Current_Task));
end if;
if J mod Notification_Interval = 0 then
Put_Line (J'Img & K'Img);
end if;
exit;
end if;
if R.Get /= J then
Assert
(False,
"Expected " & J'Img & " took " & Integer'(R.Get)'Img);
end if;
end;
end loop;
end loop Main_Loop;
exception
when E : others =>
Assert (False, "Task " & Exception_Information (E));
end Weak_Tester;
Test : array (1 .. 3) of Weak_Tester;
Stamp : constant Time := Clock;
begin
for J in Task_Outer_Range loop
declare
R : Ref;
begin
R.Set (J);
for J in Test'Range loop
Test (J).Take (R);
end loop;
delay 0.00001;
end;
if To_Duration (Clock - Stamp) > 200.0 then
Put_Line ("Too busy test machine, stop the test.");
for J in Test'Range loop
Test (J).Stop;
end loop;
exit;
end if;
end loop;
return Test_Assert.Report;
exception
when E : others =>
Assert (False, "Main " & Exception_Information (E));
for J in Test'Range loop
Test (J).Stop;
end loop;
return Test_Assert.Report;
end Test;
|