1-- C95078A.ADA 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-- OBJECTIVE: 26-- CHECK THAT AN EXCEPTION RAISED DURING THE EXECUTION OF AN ACCEPT 27-- STATEMENT CAN BE HANDLED WITHIN THE ACCEPT BODY. 28 29-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X 30-- *** remove incompatibilities associated with the transition -- 9X 31-- *** to Ada 9X. -- 9X 32-- *** -- 9X 33 34-- HISTORY: 35-- DHH 03/21/88 CREATED ORIGINAL TEST. 36-- MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY 37 38WITH REPORT; USE REPORT; 39PROCEDURE C95078A IS 40 41BEGIN 42 43 TEST("C95078A", "CHECK THAT AN EXCEPTION RAISED DURING THE " & 44 "EXECUTION OF AN ACCEPT STATEMENT CAN BE " & 45 "HANDLED WITHIN THE ACCEPT BODY"); 46 47 DECLARE 48 O,PT,QT,R,S,TP,B,C,D :INTEGER := 0; 49 TASK TYPE PROG_ERR IS 50 ENTRY START(M,N,A : IN OUT INTEGER); 51 ENTRY STOP; 52 END PROG_ERR; 53 54 TASK T IS 55 ENTRY START(M,N,A : IN OUT INTEGER); 56 ENTRY STOP; 57 END T; 58 59 TYPE REC IS 60 RECORD 61 B : PROG_ERR; 62 END RECORD; 63 64 TYPE ACC IS ACCESS PROG_ERR; 65 66 SUBTYPE X IS INTEGER RANGE 1 .. 10; 67 68 PACKAGE P IS 69 OBJ : REC; 70 END P; 71 72 TASK BODY PROG_ERR IS 73 FAULT : X; 74 BEGIN 75 ACCEPT START(M,N,A : IN OUT INTEGER) DO 76 BEGIN 77 M := IDENT_INT(1); 78 FAULT := IDENT_INT(11); 79 FAULT := IDENT_INT(FAULT); 80 EXCEPTION 81 WHEN CONSTRAINT_ERROR => 82 NULL; 83 WHEN OTHERS => 84 FAILED("UNEXPECTED ERROR RAISED - " & 85 "CONSTRAINT - TASK TYPE"); 86 END; -- EXCEPTION 87 BEGIN 88 N := IDENT_INT(1); 89 FAULT := IDENT_INT(5); 90 FAULT := FAULT/IDENT_INT(0); 91 FAULT := IDENT_INT(FAULT); 92 EXCEPTION 93 WHEN CONSTRAINT_ERROR => 94 NULL; 95 WHEN OTHERS => 96 FAILED("UNEXPECTED ERROR RAISED - " & 97 "CONSTRAINT - TASK TYPE"); 98 END; -- EXCEPTION 99 A := IDENT_INT(1); 100 END START; 101 102 ACCEPT STOP; 103 END PROG_ERR; 104 105 TASK BODY T IS 106 FAULT : X; 107 BEGIN 108 ACCEPT START(M,N,A : IN OUT INTEGER) DO 109 BEGIN 110 M := IDENT_INT(1); 111 FAULT := IDENT_INT(11); 112 FAULT := IDENT_INT(FAULT); 113 EXCEPTION 114 WHEN CONSTRAINT_ERROR => 115 NULL; 116 WHEN OTHERS => 117 FAILED("UNEXPECTED ERROR RAISED - " & 118 "CONSTRAINT - TASK"); 119 END; -- EXCEPTION 120 BEGIN 121 N := IDENT_INT(1); 122 FAULT := IDENT_INT(5); 123 FAULT := FAULT/IDENT_INT(0); 124 FAULT := IDENT_INT(FAULT); 125 EXCEPTION 126 WHEN CONSTRAINT_ERROR => 127 NULL; 128 WHEN OTHERS => 129 FAILED("UNEXPECTED ERROR RAISED - " & 130 "CONSTRAINT - TASK"); 131 END; -- EXCEPTION 132 A := IDENT_INT(1); 133 END START; 134 135 ACCEPT STOP; 136 END T; 137 138 PACKAGE BODY P IS 139 BEGIN 140 OBJ.B.START(O,PT,B); 141 OBJ.B.STOP; 142 143 IF O /= IDENT_INT(1) OR PT /= IDENT_INT(1) THEN 144 FAILED("EXCEPTION HANDLER NEVER ENTERED " & 145 "PROPERLY - TASK TYPE OBJECT"); 146 END IF; 147 148 IF B /= IDENT_INT(1) THEN 149 FAILED("TASK NOT EXITED PROPERLY - TASK TYPE " & 150 "OBJECT"); 151 END IF; 152 END P; 153 154 PACKAGE Q IS 155 OBJ : ACC; 156 END Q; 157 158 PACKAGE BODY Q IS 159 BEGIN 160 OBJ := NEW PROG_ERR; 161 OBJ.START(QT,R,C); 162 OBJ.STOP; 163 164 IF QT /= IDENT_INT(1) OR R /= IDENT_INT(1) THEN 165 FAILED("EXCEPTION HANDLER NEVER ENTERED " & 166 "PROPERLY - ACCESS TASK TYPE"); 167 END IF; 168 169 IF C /= IDENT_INT(1) THEN 170 FAILED("TASK NOT EXITED PROPERLY - ACCESS TASK " & 171 "TYPE"); 172 END IF; 173 END; 174 175 BEGIN 176 T.START(S,TP,D); 177 T.STOP; 178 179 IF S /= IDENT_INT(1) OR TP /= IDENT_INT(1) THEN 180 FAILED("EXCEPTION HANDLER NEVER ENTERED PROPERLY " & 181 "- TASK"); 182 END IF; 183 184 IF D /= IDENT_INT(1) THEN 185 FAILED("TASK NOT EXITED PROPERLY - TASK"); 186 END IF; 187 END; -- DECLARE 188 189 RESULT; 190 191EXCEPTION 192 WHEN OTHERS => 193 FAILED("EXCEPTION NOT HANDLED INSIDE ACCEPT BODY"); 194 RESULT; 195END C95078A; 196