1-- C95085A.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-- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR 26-- ARGUMENTS. SUBTESTS ARE: 27-- (A) STATIC IN ARGUMENT. 28-- (B) DYNAMIC IN ARGUMENT. 29-- (C) IN OUT, OUT OF RANGE ON CALL. 30-- (D) OUT, OUT OF RANGE ON RETURN. 31-- (E) IN OUT, OUT OF RANGE ON RETURN. 32 33-- GLH 7/15/85 34-- JRK 8/23/85 35-- JWC 11/15/85 ADDED VARIABLE "CALLED" TO ENSURE THAT THE ENTRY 36-- CALL WAS MADE FOR THOSE CASES THAT ARE APPLICABLE. 37 38WITH REPORT; USE REPORT; 39PROCEDURE C95085A IS 40 41 SUBTYPE DIGIT IS INTEGER RANGE 0..9; 42 43 D : DIGIT; 44 I : INTEGER; 45 M1 : CONSTANT INTEGER := IDENT_INT (-1); 46 COUNT : INTEGER := 0; 47 CALLED : BOOLEAN; 48 49 SUBTYPE SI IS INTEGER RANGE M1 .. 10; 50 51 TASK T1 IS 52 ENTRY E1 (PIN : IN DIGIT; WHO : STRING); -- (A), (B). 53 END T1; 54 55 TASK BODY T1 IS 56 BEGIN 57 LOOP 58 BEGIN 59 SELECT 60 ACCEPT E1 (PIN : IN DIGIT; 61 WHO : STRING) DO -- (A), (B). 62 FAILED ("EXCEPTION NOT RAISED BEFORE " & 63 "CALL - E1 " & WHO); 64 END E1; 65 OR 66 TERMINATE; 67 END SELECT; 68 EXCEPTION 69 WHEN OTHERS => 70 FAILED ("EXCEPTION RAISED IN E1"); 71 END; 72 END LOOP; 73 END T1; 74 75 TASK T2 IS 76 ENTRY E2 (PINOUT : IN OUT DIGIT; WHO : STRING); -- (C). 77 END T2; 78 79 TASK BODY T2 IS 80 BEGIN 81 LOOP 82 BEGIN 83 SELECT 84 ACCEPT E2 (PINOUT : IN OUT DIGIT; 85 WHO : STRING) DO -- (C). 86 FAILED ("EXCEPTION NOT RAISED BEFORE " & 87 "CALL - E2 " & WHO); 88 END E2; 89 OR 90 TERMINATE; 91 END SELECT; 92 EXCEPTION 93 WHEN OTHERS => 94 FAILED ("EXCEPTION RAISED IN E2"); 95 END; 96 END LOOP; 97 END T2; 98 99 TASK T3 IS 100 ENTRY E3 (POUT : OUT SI; WHO : STRING); -- (D). 101 END T3; 102 103 TASK BODY T3 IS 104 BEGIN 105 LOOP 106 BEGIN 107 SELECT 108 ACCEPT E3 (POUT : OUT SI; 109 WHO : STRING) DO -- (D). 110 CALLED := TRUE; 111 IF WHO = "10" THEN 112 POUT := IDENT_INT (10); -- 10 IS NOT 113 -- A DIGIT. 114 ELSE 115 POUT := -1; 116 END IF; 117 END E3; 118 OR 119 TERMINATE; 120 END SELECT; 121 EXCEPTION 122 WHEN OTHERS => 123 FAILED ("EXCEPTION RAISED IN E3"); 124 END; 125 END LOOP; 126 END T3; 127 128 TASK T4 IS 129 ENTRY E4 (PINOUT : IN OUT INTEGER; WHO : STRING); -- (E). 130 END T4; 131 132 TASK BODY T4 IS 133 BEGIN 134 LOOP 135 BEGIN 136 SELECT 137 ACCEPT E4 (PINOUT : IN OUT INTEGER; 138 WHO : STRING) DO -- (E). 139 CALLED := TRUE; 140 IF WHO = "10" THEN 141 PINOUT := 10; -- 10 IS NOT A DIGIT. 142 ELSE 143 PINOUT := IDENT_INT (-1); 144 END IF; 145 END E4; 146 OR 147 TERMINATE; 148 END SELECT; 149 EXCEPTION 150 WHEN OTHERS => 151 FAILED ("EXCEPTION RAISED IN E4"); 152 END; 153 END LOOP; 154 END T4; 155 156BEGIN 157 158 TEST ("C95085A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " & 159 "FOR OUT OF RANGE SCALAR ARGUMENTS"); 160 161 BEGIN -- (A) 162 T1.E1 (10, "10"); 163 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (10)"); 164 EXCEPTION 165 WHEN CONSTRAINT_ERROR => 166 COUNT := COUNT + 1; 167 WHEN OTHERS => 168 FAILED ("WRONG EXCEPTION RAISED FOR E1 (10)"); 169 END; -- (A) 170 171 BEGIN -- (B) 172 T1.E1 (IDENT_INT (-1), "-1"); 173 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (" & 174 "IDENT_INT (-1))"); 175 EXCEPTION 176 WHEN CONSTRAINT_ERROR => 177 COUNT := COUNT + 1; 178 WHEN OTHERS => 179 FAILED ("WRONG EXCEPTION RAISED FOR E1 (" & 180 "IDENT_INT (-1))"); 181 END; -- (B) 182 183 BEGIN -- (C) 184 I := IDENT_INT (10); 185 T2.E2 (I, "10"); 186 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (10)"); 187 EXCEPTION 188 WHEN CONSTRAINT_ERROR => 189 COUNT := COUNT + 1; 190 WHEN OTHERS => 191 FAILED ("WRONG EXCEPTION RAISED FOR E2 (10)"); 192 END; -- (C) 193 194 BEGIN -- (C1) 195 I := IDENT_INT (-1); 196 T2.E2 (I, "-1"); 197 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (-1)"); 198 EXCEPTION 199 WHEN CONSTRAINT_ERROR => 200 COUNT := COUNT + 1; 201 WHEN OTHERS => 202 FAILED ("WRONG EXCEPTION RAISED FOR E2 (-1)"); 203 END; -- (C1) 204 205 BEGIN -- (D) 206 CALLED := FALSE; 207 D := IDENT_INT (1); 208 T3.E3 (D, "10"); 209 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " & 210 "E3 (10)"); 211 EXCEPTION 212 WHEN CONSTRAINT_ERROR => 213 COUNT := COUNT + 1; 214 IF NOT CALLED THEN 215 FAILED ("EXCEPTION RAISED BEFORE CALL " & 216 "E3 (10)"); 217 END IF; 218 WHEN OTHERS => 219 FAILED ("WRONG EXCEPTION RAISED FOR E3 (10)"); 220 END; -- (D) 221 222 BEGIN -- (D1) 223 CALLED := FALSE; 224 D := IDENT_INT (1); 225 T3.E3 (D, "-1"); 226 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " & 227 "E3 (-1)"); 228 EXCEPTION 229 WHEN CONSTRAINT_ERROR => 230 COUNT := COUNT + 1; 231 IF NOT CALLED THEN 232 FAILED ("EXCEPTION RAISED BEFORE CALL " & 233 "E3 (-1)"); 234 END IF; 235 WHEN OTHERS => 236 FAILED ("WRONG EXCEPTION RAISED FOR E3 (-1)"); 237 END; -- (D1) 238 239 BEGIN -- (E) 240 CALLED := FALSE; 241 D := 9; 242 T4.E4 (D, "10"); 243 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " & 244 "E4 (10)"); 245 EXCEPTION 246 WHEN CONSTRAINT_ERROR => 247 COUNT := COUNT + 1; 248 IF NOT CALLED THEN 249 FAILED ("EXCEPTION RAISED BEFORE CALL " & 250 "E4 (10)"); 251 END IF; 252 WHEN OTHERS => 253 FAILED ("WRONG EXCEPTION RAISED FOR E4 (10)"); 254 END; -- (E) 255 256 BEGIN -- (E1) 257 CALLED := FALSE; 258 D := 0; 259 T4.E4 (D, "-1"); 260 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " & 261 "E4 (-1)"); 262 EXCEPTION 263 WHEN CONSTRAINT_ERROR => 264 COUNT := COUNT + 1; 265 IF NOT CALLED THEN 266 FAILED ("EXCEPTION RAISED BEFORE CALL " & 267 "E4 (-1)"); 268 END IF; 269 WHEN OTHERS => 270 FAILED ("WRONG EXCEPTION RAISED FOR E4 (-1)"); 271 END; -- (E1) 272 273 IF COUNT /= 8 THEN 274 FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED"); 275 END IF; 276 277 RESULT; 278 279END C95085A; 280