1-- C940014.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 as part of the finalization of a protected object 28-- each call remaining on an entry queue of the objet is removed 29-- from its queue and Program_Error is raised at the place of 30-- the corresponding entry_call_statement. 31-- 32-- TEST DESCRIPTION: 33-- The example in 9.4(20a-20f);6.0 demonstrates how to cause a 34-- protected object to finalize while tasks are still waiting 35-- on its entry queues. The first part of this test mirrors 36-- that example. The second part of the test expands upon 37-- the example code to add an object with finalization code 38-- to the protected object. The finalization code should be 39-- executed after Program_Error is raised in the callers left 40-- on the entry queues. 41-- 42-- 43-- CHANGE HISTORY: 44-- 08 Jan 96 SAIC Initial Release for 2.1 45-- 10 Jul 96 SAIC Incorporated Reviewer comments to fix race 46-- condition. 47-- 48--! 49 50 51with Ada.Finalization; 52package C940014_0 is 53 Verbose : constant Boolean := False; 54 Finalization_Occurred : Boolean := False; 55 56 type Has_Finalization is new Ada.Finalization.Limited_Controlled with 57 record 58 Placeholder : Integer; 59 end record; 60 procedure Finalize (Object : in out Has_Finalization); 61end C940014_0; 62 63 64with Report; 65with ImpDef; 66package body C940014_0 is 67 procedure Finalize (Object : in out Has_Finalization) is 68 begin 69 delay ImpDef.Clear_Ready_Queue; 70 Finalization_Occurred := True; 71 if Verbose then 72 Report.Comment ("in Finalize"); 73 end if; 74 end Finalize; 75end C940014_0; 76 77 78 79with Report; 80with ImpDef; 81with Ada.Finalization; 82with C940014_0; 83 84procedure C940014 is 85 Verbose : constant Boolean := C940014_0.Verbose; 86 87begin 88 89 Report.Test ("C940014", "Check that the finalization of a protected" & 90 " object results in program_error being raised" & 91 " at the point of the entry call statement for" & 92 " any tasks remaining on any entry queue"); 93 94 First_Check: declare 95 -- example from ARM 9.4(20a-f);6.0 with minor mods 96 task T is 97 entry E; 98 end T; 99 task body T is 100 protected PO is 101 entry Ee; 102 end PO; 103 protected body PO is 104 entry Ee when Report.Ident_Bool (False) is 105 begin 106 null; 107 end Ee; 108 end PO; 109 begin 110 accept E do 111 requeue PO.Ee; 112 end E; 113 if Verbose then 114 Report.Comment ("task about to terminate"); 115 end if; 116 end T; 117 begin -- First_Check 118 begin 119 T.E; 120 delay ImpDef.Clear_Ready_Queue; 121 Report.Failed ("exception not raised in First_Check"); 122 exception 123 when Program_Error => 124 if Verbose then 125 Report.Comment ("ARM Example passed"); 126 end if; 127 when others => 128 Report.Failed ("wrong exception in First_Check"); 129 end; 130 end First_Check; 131 132 133 Second_Check : declare 134 -- here we want to check that the raising of Program_Error 135 -- occurs before the other finalization actions. 136 task T is 137 entry E; 138 end T; 139 task body T is 140 protected PO is 141 entry Ee; 142 private 143 Component : C940014_0.Has_Finalization; 144 end PO; 145 protected body PO is 146 entry Ee when Report.Ident_Bool (False) is 147 begin 148 null; 149 end Ee; 150 end PO; 151 begin 152 accept E do 153 requeue PO.Ee; 154 end E; 155 if Verbose then 156 Report.Comment ("task about to terminate"); 157 end if; 158 end T; 159 begin -- Second_Check 160 T.E; 161 delay ImpDef.Clear_Ready_Queue; 162 Report.Failed ("exception not raised in Second_Check"); 163 exception 164 when Program_Error => 165 if C940014_0.Finalization_Occurred then 166 Report.Failed ("wrong order for finalization"); 167 elsif Verbose then 168 Report.Comment ("Second_Check passed"); 169 end if; 170 when others => 171 Report.Failed ("Wrong exception in Second_Check"); 172 end Second_Check; 173 174 175 Report.Result; 176 177end C940014; 178