1-- C95086C.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 NOT RAISED FOR ACCESS PARAMETERS 26-- AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL 27-- ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS 28-- DIFFERENT CONSTRAINTS. 29-- 30-- SUBTESTS ARE: 31-- (A) IN OUT MODE, STATIC PRIVATE DISCRIMINANT. 32-- (B) OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS. 33-- (C) SAME AS (A), WITH TYPE CONVERSION. 34-- (D) SAME AS (B), WITH TYPE CONVERSION. 35 36-- RJW 1/29/86 37 38WITH REPORT; USE REPORT; 39PROCEDURE C95086C IS 40 41BEGIN 42 TEST ("C95086C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " & 43 "AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL " & 44 "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " & 45 "DIFFERENT CONSTRAINTS" ); 46 47 -------------------------------------------------- 48 49 DECLARE -- (A) 50 51 PACKAGE PKG IS 52 TYPE E IS (E1, E2); 53 TYPE T (D : E := E1) IS PRIVATE; 54 PRIVATE 55 TYPE T (D : E := E1) IS 56 RECORD 57 I : INTEGER; 58 CASE D IS 59 WHEN E1 => 60 B : BOOLEAN; 61 WHEN E2 => 62 C : CHARACTER; 63 END CASE; 64 END RECORD; 65 END PKG; 66 67 USE PKG; 68 69 TYPE A IS ACCESS T; 70 SUBTYPE SA IS A (E2); 71 V : A (E1) := NULL; 72 ENTERED : BOOLEAN := FALSE; 73 74 TASK T1 IS 75 ENTRY P (X : IN OUT SA); 76 END T1; 77 78 TASK BODY T1 IS 79 BEGIN 80 ACCEPT P (X : IN OUT SA) DO 81 ENTERED := TRUE; 82 X := NULL; 83 END P; 84 EXCEPTION 85 WHEN OTHERS => 86 FAILED ("EXCEPTION RAISED IN TASK - (A)"); 87 END T1; 88 89 BEGIN -- (A) 90 91 T1.P (V); 92 93 EXCEPTION 94 WHEN CONSTRAINT_ERROR => 95 IF NOT ENTERED THEN 96 FAILED ("EXCEPTION RAISED BEFORE CALL - (A)"); 97 ELSE 98 FAILED ("EXCEPTION RAISED ON RETURN - (A)"); 99 END IF; 100 WHEN OTHERS => 101 FAILED ("EXCEPTION RAISED - (A)"); 102 END; -- (A) 103 104 -------------------------------------------------- 105 106 DECLARE -- (B) 107 108 TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF 109 INTEGER; 110 111 TYPE A IS ACCESS T; 112 SUBTYPE SA IS A ('D'..'F', FALSE..FALSE); 113 V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'), 114 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL; 115 ENTERED : BOOLEAN := FALSE; 116 117 TASK T1 IS 118 ENTRY P (X : OUT SA); 119 END T1; 120 121 TASK BODY T1 IS 122 BEGIN 123 ACCEPT P (X : OUT SA) DO 124 ENTERED := TRUE; 125 X := NULL; 126 END P; 127 EXCEPTION 128 WHEN OTHERS => 129 FAILED ("EXCEPTION RAISED IN TASK - (B)"); 130 END T1; 131 132 BEGIN -- (B) 133 134 T1.P (V); 135 136 EXCEPTION 137 WHEN CONSTRAINT_ERROR => 138 IF NOT ENTERED THEN 139 FAILED ("EXCEPTION RAISED BEFORE CALL - (B)"); 140 ELSE 141 FAILED ("EXCEPTION RAISED ON RETURN - (B)"); 142 END IF; 143 WHEN OTHERS => 144 FAILED ("EXCEPTION RAISED - (B)"); 145 END; -- (B) 146 147 -------------------------------------------------- 148 149 DECLARE -- (C) 150 151 PACKAGE PKG IS 152 TYPE E IS (E1, E2); 153 TYPE T (D : E := E1) IS PRIVATE; 154 PRIVATE 155 TYPE T (D : E := E1) IS 156 RECORD 157 I : INTEGER; 158 CASE D IS 159 WHEN E1 => 160 B : BOOLEAN; 161 WHEN E2 => 162 C : CHARACTER; 163 END CASE; 164 END RECORD; 165 END PKG; 166 167 USE PKG; 168 169 TYPE A IS ACCESS T; 170 SUBTYPE SA IS A (E2); 171 V : A (E1) := NULL; 172 ENTERED : BOOLEAN := FALSE; 173 174 TASK T1 IS 175 ENTRY P (X : IN OUT SA); 176 END T1; 177 178 TASK BODY T1 IS 179 BEGIN 180 ACCEPT P (X : IN OUT SA) DO 181 ENTERED := TRUE; 182 X := NULL; 183 END P; 184 EXCEPTION 185 WHEN OTHERS => 186 FAILED ("EXCEPTION RAISED IN TASK - (C)"); 187 END T1; 188 189 BEGIN -- (C) 190 191 T1.P (SA(V)); 192 193 EXCEPTION 194 WHEN CONSTRAINT_ERROR => 195 IF NOT ENTERED THEN 196 FAILED ("EXCEPTION RAISED BEFORE CALL - (C)"); 197 ELSE 198 FAILED ("EXCEPTION RAISED ON RETURN - (C)"); 199 END IF; 200 WHEN OTHERS => 201 FAILED ("EXCEPTION RAISED - (C)"); 202 END; -- (C) 203 204 -------------------------------------------------- 205 206 DECLARE -- (D) 207 208 TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF 209 INTEGER; 210 211 TYPE A IS ACCESS T; 212 SUBTYPE SA IS A ('D'..'F', FALSE..FALSE); 213 V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'), 214 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL; 215 ENTERED : BOOLEAN := FALSE; 216 217 TASK T1 IS 218 ENTRY P (X : OUT SA); 219 END T1; 220 221 TASK BODY T1 IS 222 BEGIN 223 ACCEPT P (X : OUT SA) DO 224 ENTERED := TRUE; 225 X := NULL; 226 END P; 227 EXCEPTION 228 WHEN OTHERS => 229 FAILED ("EXCEPTION RAISED IN TASK - (D)"); 230 END T1; 231 232 BEGIN -- (D) 233 234 T1.P (SA(V)); 235 236 EXCEPTION 237 WHEN CONSTRAINT_ERROR => 238 IF NOT ENTERED THEN 239 FAILED ("EXCEPTION RAISED BEFORE CALL - (D)"); 240 ELSE 241 FAILED ("EXCEPTION RAISED ON RETURN - (D)"); 242 END IF; 243 WHEN OTHERS => 244 FAILED ("EXCEPTION RAISED - (D)"); 245 END; -- (D) 246 247 -------------------------------------------------- 248 249 RESULT; 250END C95086C; 251