1-- C980002.A 2-- 3-- Grant of Unlimited Rights 4-- 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 14-- to do so. 15-- 16-- DISCLAIMER 17-- 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. 24--* 25-- 26-- OBJECTIVE: 27-- Check that aborts are deferred during protected actions. 28-- 29-- TEST DESCRIPTION: 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. 34-- 35-- 36-- CHANGE HISTORY: 37-- 30 OCT 95 SAIC ACVC 2.1 38-- 39--! 40 41with Report; 42procedure C980002 is 43 44 Max_Checkpoints : constant := 7; 45 type Checkpoint_ID is range 1..Max_Checkpoints; 46 type Points_Array is array (Checkpoint_ID) of Boolean; 47begin 48 Report.Test ("C980002", 49 "Check that aborts are deferred during a protected action" & 50 " including requeues"); 51 52 declare -- test encapsulation 53 54 protected Checkpoint is 55 procedure Got_Here (Id : Checkpoint_ID); 56 function Results return Points_Array; 57 private 58 Reached_Points : Points_Array := (others => False); 59 end Checkpoint; 60 61 protected body Checkpoint is 62 procedure Got_Here (Id : Checkpoint_ID) is 63 begin 64 Reached_Points (Id) := True; 65 end Got_Here; 66 67 function Results return Points_Array is 68 begin 69 return Reached_Points; 70 end Results; 71 end Checkpoint; 72 73 74 protected Start_Here is 75 entry AST_Waits_Here; 76 entry Start_PO; 77 private 78 Open : Boolean := False; 79 entry First_Stop; 80 end Start_Here; 81 82 protected Middle_PO is 83 entry Stop_1; 84 entry Stop_2; 85 end Middle_PO; 86 87 protected Final_PO is 88 entry Final_Stop; 89 end Final_PO; 90 91 92 protected body Start_Here is 93 entry AST_Waits_Here when Open is 94 begin 95 null; 96 end AST_Waits_Here; 97 98 entry Start_PO when True is 99 begin 100 Open := True; 101 Checkpoint.Got_Here (1); 102 requeue First_Stop; 103 end Start_PO; 104 105 -- make sure the AST has been accepted before continuing 106 entry First_Stop when AST_Waits_Here'Count = 0 is 107 begin 108 Checkpoint.Got_Here (2); 109 requeue Middle_PO.Stop_1; 110 end First_Stop; 111 end Start_Here; 112 113 protected body Middle_PO is 114 entry Stop_1 when True is 115 begin 116 Checkpoint.Got_Here (3); 117 requeue Stop_2; 118 end Stop_1; 119 120 entry Stop_2 when True is 121 begin 122 Checkpoint.Got_Here (4); 123 requeue Final_PO.Final_Stop; 124 end Stop_2; 125 end Middle_PO; 126 127 protected body Final_PO is 128 entry Final_Stop when True is 129 begin 130 Checkpoint.Got_Here (5); 131 end Final_Stop; 132 end Final_PO; 133 134 135 begin -- test encapsulation 136 select 137 Start_Here.AST_Waits_Here; 138 Checkpoint.Got_Here (6); 139 then abort 140 Start_Here.Start_PO; 141 delay 0.0; -- abort completion point 142 Checkpoint.Got_Here (7); 143 end select; 144 145 Check_The_Results: declare 146 Chk : constant Points_Array := Checkpoint.Results; 147 Expected : constant Points_Array := (1..6 => True, 148 7 => False); 149 begin 150 for I in Checkpoint_ID loop 151 if Chk (I) /= Expected (I) then 152 Report.Failed ("checkpoint error" & 153 Checkpoint_ID'Image (I) & 154 " actual is " & 155 Boolean'Image (Chk(I))); 156 end if; 157 end loop; 158 end Check_The_Results; 159 exception 160 when others => 161 Report.Failed ("unexpected exception"); 162 end; -- test encapsulation 163 164 Report.Result; 165end C980002; 166