3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
27 -- Check that aborts are deferred during protected actions.
30 -- This test uses an asynchronous transfer of control to attempt
31 -- to abort a protected operation. The protected operation
32 -- includes several requeues to check that the requeue does not
33 -- allow the abort to occur.
37 -- 30 OCT 95 SAIC ACVC 2.1
44 Max_Checkpoints
: constant := 7;
45 type Checkpoint_ID
is range 1..Max_Checkpoints
;
46 type Points_Array
is array (Checkpoint_ID
) of Boolean;
48 Report
.Test
("C980002",
49 "Check that aborts are deferred during a protected action" &
50 " including requeues");
52 declare -- test encapsulation
54 protected Checkpoint
is
55 procedure Got_Here
(Id
: Checkpoint_ID
);
56 function Results
return Points_Array
;
58 Reached_Points
: Points_Array
:= (others => False);
61 protected body Checkpoint
is
62 procedure Got_Here
(Id
: Checkpoint_ID
) is
64 Reached_Points
(Id
) := True;
67 function Results
return Points_Array
is
69 return Reached_Points
;
74 protected Start_Here
is
78 Open
: Boolean := False;
82 protected Middle_PO
is
92 protected body Start_Here
is
93 entry AST_Waits_Here
when Open
is
98 entry Start_PO
when True is
101 Checkpoint
.Got_Here
(1);
105 -- make sure the AST has been accepted before continuing
106 entry First_Stop
when AST_Waits_Here
'Count = 0 is
108 Checkpoint
.Got_Here
(2);
109 requeue Middle_PO
.Stop_1
;
113 protected body Middle_PO
is
114 entry Stop_1
when True is
116 Checkpoint
.Got_Here
(3);
120 entry Stop_2
when True is
122 Checkpoint
.Got_Here
(4);
123 requeue Final_PO
.Final_Stop
;
127 protected body Final_PO
is
128 entry Final_Stop
when True is
130 Checkpoint
.Got_Here
(5);
135 begin -- test encapsulation
137 Start_Here
.AST_Waits_Here
;
138 Checkpoint
.Got_Here
(6);
141 delay 0.0; -- abort completion point
142 Checkpoint
.Got_Here
(7);
145 Check_The_Results
: declare
146 Chk
: constant Points_Array
:= Checkpoint
.Results
;
147 Expected
: constant Points_Array
:= (1..6 => True,
150 for I
in Checkpoint_ID
loop
151 if Chk
(I
) /= Expected
(I
) then
152 Report
.Failed
("checkpoint error" &
153 Checkpoint_ID
'Image (I
) &
155 Boolean'Image (Chk
(I
)));
158 end Check_The_Results
;
161 Report
.Failed
("unexpected exception");
162 end; -- test encapsulation