1-- C980003.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-- TEST OBJECTIVE: 27-- Check that aborts are deferred during the execution of an 28-- Initialize procedure (as the last step of the default 29-- initialization of a controlled object), during the execution 30-- of a Finalize procedure (as part of the finalization of a 31-- controlled object), and during an assignment operation to an 32-- object with a controlled part. 33-- 34-- TEST DESCRIPTION: 35-- A controlled type is created with Initialize, Adjust, and 36-- Finalize operations. These operations note in a protected 37-- object when the operation starts and completes. This change 38-- in state of the protected object will open the barrier for 39-- the entry in the protected object. 40-- The test contains declarations of objects of the controlled 41-- type. An asynchronous select is used to attempt to abort 42-- the operations on the controlled type. The asynchronous select 43-- makes use of the state change to the protected object to 44-- trigger the abort. 45-- 46-- 47-- CHANGE HISTORY: 48-- 11 Jan 96 SAIC Initial Release for 2.1 49-- 5 May 96 SAIC Incorporated Reviewer comments. 50-- 10 Oct 96 SAIC Addressed issue where assignment statement 51-- can be 2 assignment operations. 52-- 53--! 54 55with Ada.Finalization; 56package C980003_0 is 57 Verbose : constant Boolean := False; 58 59 -- the following flag is set true whenever the 60 -- Initialize operation is called. 61 Init_Occurred : Boolean; 62 63 type Is_Controlled is new Ada.Finalization.Controlled with 64 record 65 Id : Integer; 66 end record; 67 68 procedure Initialize (Object : in out Is_Controlled); 69 procedure Finalize (Object : in out Is_Controlled); 70 procedure Adjust (Object : in out Is_Controlled); 71 72 type States is (Unknown, 73 Start_Init, Finished_Init, 74 Start_Adjust, Finished_Adjust, 75 Start_Final, Finished_Final); 76 77 protected State_Manager is 78 procedure Reset; 79 procedure Set (New_State : States); 80 function Current return States; 81 entry Wait_For_Change; 82 private 83 Current_State : States := Unknown; 84 Changed : Boolean := False; 85 end State_Manager; 86 87end C980003_0; 88 89 90with Report; 91with ImpDef; 92package body C980003_0 is 93 protected body State_Manager is 94 procedure Reset is 95 begin 96 Current_State := Unknown; 97 Changed := False; 98 end Reset; 99 100 procedure Set (New_State : States) is 101 begin 102 Changed := True; 103 Current_State := New_State; 104 end Set; 105 106 function Current return States is 107 begin 108 return Current_State; 109 end Current; 110 111 entry Wait_For_Change when Changed is 112 begin 113 Changed := False; 114 end Wait_For_Change; 115 end State_Manager; 116 117 procedure Initialize (Object : in out Is_Controlled) is 118 begin 119 if Verbose then 120 Report.Comment ("starting initialize"); 121 end if; 122 State_Manager.Set (Start_Init); 123 if Verbose then 124 Report.Comment ("in initialize"); 125 end if; 126 delay ImpDef.Switch_To_New_Task; -- tempting place for abort 127 State_Manager.Set (Finished_Init); 128 if Verbose then 129 Report.Comment ("finished initialize"); 130 end if; 131 Init_Occurred := True; 132 end Initialize; 133 134 procedure Finalize (Object : in out Is_Controlled) is 135 begin 136 if Verbose then 137 Report.Comment ("starting finalize"); 138 end if; 139 State_Manager.Set (Start_Final); 140 if Verbose then 141 Report.Comment ("in finalize"); 142 end if; 143 delay ImpDef.Switch_To_New_Task; -- tempting place for abort 144 State_Manager.Set (Finished_Final); 145 if Verbose then 146 Report.Comment ("finished finalize"); 147 end if; 148 end Finalize; 149 150 procedure Adjust (Object : in out Is_Controlled) is 151 begin 152 if Verbose then 153 Report.Comment ("starting adjust"); 154 end if; 155 State_Manager.Set (Start_Adjust); 156 if Verbose then 157 Report.Comment ("in adjust"); 158 end if; 159 delay ImpDef.Switch_To_New_Task; -- tempting place for abort 160 State_Manager.Set (Finished_Adjust); 161 if Verbose then 162 Report.Comment ("finished adjust"); 163 end if; 164 end Adjust; 165end C980003_0; 166 167 168with Report; 169with ImpDef; 170with C980003_0; use C980003_0; 171with Ada.Unchecked_Deallocation; 172procedure C980003 is 173 174 procedure Check_State (Should_Be : States; 175 Msg : String) is 176 Cur : States := State_Manager.Current; 177 begin 178 if Cur /= Should_Be then 179 Report.Failed (Msg); 180 Report.Comment ("expected: " & States'Image (Should_Be) & 181 " found: " & States'Image (Cur)); 182 elsif Verbose then 183 Report.Comment ("passed: " & Msg); 184 end if; 185 end Check_State; 186 187begin 188 189 Report.Test ("C980003", "Check that aborts are deferred during" & 190 " initialization, finalization, and assignment" & 191 " operations on controlled objects"); 192 193 Check_State (Unknown, "initial condition"); 194 195 -- check that initialization and finalization take place 196 Init_Occurred := False; 197 select 198 State_Manager.Wait_For_Change; 199 then abort 200 declare 201 My_Controlled_Obj : Is_Controlled; 202 begin 203 delay 0.0; -- abort completion point 204 Report.Failed ("state change did not occur"); 205 end; 206 end select; 207 if not Init_Occurred then 208 Report.Failed ("Initialize did not complete"); 209 end if; 210 Check_State (Finished_Final, "init/final for declared item"); 211 212 -- check adjust 213 State_Manager.Reset; 214 declare 215 Source, Dest : Is_Controlled; 216 begin 217 Check_State (Finished_Init, "adjust initial state"); 218 Source.Id := 3; 219 Dest.Id := 4; 220 State_Manager.Reset; -- so we will wait for change 221 select 222 State_Manager.Wait_For_Change; 223 then abort 224 Dest := Source; 225 end select; 226 227 -- there are two implementation methods for the 228 -- assignment statement: 229 -- 1. no temporary was used in the assignment statement 230 -- thus the entire 231 -- assignment statement is abort deferred. 232 -- 2. a temporary was used in the assignment statement so 233 -- there are two assignment operations. An abort may 234 -- occur between the assignment operations 235 -- Various optimizations are allowed by 7.6 that can affect 236 -- how many times Adjust and Finalize are called. 237 -- Depending upon the implementation, the state can be either 238 -- Finished_Adjust or Finished_Finalize. If it is any other 239 -- state then the abort took place at the wrong time. 240 241 case State_Manager.Current is 242 when Finished_Adjust => 243 if Verbose then 244 Report.Comment ("assignment aborted after adjust"); 245 end if; 246 when Finished_Final => 247 if Verbose then 248 Report.Comment ("assignment aborted after finalize"); 249 end if; 250 when Start_Adjust => 251 Report.Failed ("assignment aborted in adjust"); 252 when Start_Final => 253 Report.Failed ("assignment aborted in finalize"); 254 when Start_Init => 255 Report.Failed ("assignment aborted in initialize"); 256 when Finished_Init => 257 Report.Failed ("assignment aborted after initialize"); 258 when Unknown => 259 Report.Failed ("assignment aborted in unknown state"); 260 end case; 261 262 263 if Dest.Id /= 3 then 264 if Verbose then 265 Report.Comment ("assignment not performed"); 266 end if; 267 end if; 268 end; 269 270 271 -- check dynamically allocated objects 272 State_Manager.Reset; 273 declare 274 type Pointer_Type is access Is_Controlled; 275 procedure Free is new Ada.Unchecked_Deallocation ( 276 Is_Controlled, Pointer_Type); 277 Ptr : Pointer_Type; 278 begin 279 -- make sure initialize is done when object is allocated 280 Ptr := new Is_Controlled; 281 Check_State (Finished_Init, "init when item allocated"); 282 -- now try aborting the finalize 283 State_Manager.Reset; 284 select 285 State_Manager.Wait_For_Change; 286 then abort 287 Free (Ptr); 288 end select; 289 Check_State (Finished_Final, "finalization in dealloc"); 290 end; 291 292 Report.Result; 293 294end C980003; 295