1-- C95086F.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 BEFORE OR AFTER THE ENTRY 26-- CALL FOR OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE 27-- FORM OF A TYPE CONVERSION. THE FOLLOWING CASES ARE TESTED: 28-- (A) OK CASE. 29-- (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER 30-- COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE 31-- FORMAL INDEX SUBTYPE. 32-- (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER 33-- COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL 34-- ARRAYS. 35-- (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE 36-- FORMAL INDEX SUBTYPE. 37-- (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE 38-- FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY. 39 40-- RJW 2/3/86 41-- TMB 11/15/95 FIXED INCOMPATIBILITIES WITH ADA95 42-- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D 43 44WITH REPORT; USE REPORT; 45PROCEDURE C95086F IS 46 47BEGIN 48 TEST ("C95086F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " & 49 "BEFORE OR AFTER THE ENTRY CALL FOR OUT ARRAY PARAMETERS, " & 50 "WITH THE ACTUAL HAVING THE FORM OF A TYPE CONVERSION"); 51 52 --------------------------------------------- 53 54 DECLARE -- (A) 55 56 SUBTYPE INDEX IS INTEGER RANGE 1..5; 57 TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) 58 OF BOOLEAN; 59 SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3); 60 SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3); 61 AR : ACTUAL; 62 CALLED : BOOLEAN := FALSE; 63 64 TASK T IS 65 ENTRY E (X : OUT FORMAL); 66 END T; 67 68 TASK BODY T IS 69 BEGIN 70 ACCEPT E (X : OUT FORMAL) DO 71 CALLED := TRUE; 72 X := (1..3 => (1..3 => TRUE)); 73 END E; 74 EXCEPTION 75 WHEN OTHERS => 76 FAILED ("EXCEPTION RAISED IN TASK - (A)"); 77 END T; 78 79 BEGIN -- (A) 80 81 T.E (FORMAL (AR)); 82 83 EXCEPTION 84 WHEN CONSTRAINT_ERROR => 85 IF NOT CALLED THEN 86 FAILED ("EXCEPTION RAISED BEFORE CALL - (A)"); 87 ELSE 88 FAILED ("EXCEPTION RAISED ON RETURN - (A)"); 89 END IF; 90 WHEN OTHERS => 91 FAILED ("EXCEPTION RAISED - (A)"); 92 END; -- (A) 93 94 --------------------------------------------- 95 96 DECLARE -- (B) 97 98 SUBTYPE INDEX IS INTEGER RANGE 1..3; 99 TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN; 100 TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN; 101 AR : ACTUAL; 102 CALLED : BOOLEAN := FALSE; 103 104 TASK T IS 105 ENTRY E (X : OUT FORMAL); 106 END T; 107 108 TASK BODY T IS 109 BEGIN 110 ACCEPT E (X : OUT FORMAL) DO 111 CALLED := TRUE; 112 X(3, 3) := TRUE; 113 END E; 114 EXCEPTION 115 WHEN OTHERS => 116 FAILED ("EXCEPTION RAISED IN TASK - (B)"); 117 END T; 118 119 BEGIN -- (B) 120 121 T.E (FORMAL (AR)); 122 IF AR(5, 5) /= TRUE THEN 123 FAILED ("INCORRECT RETURNED VALUE - (B)"); 124 END IF; 125 126 EXCEPTION 127 WHEN CONSTRAINT_ERROR => 128 IF NOT CALLED THEN 129 FAILED ("EXCEPTION RAISED BEFORE CALL - (B)"); 130 ELSE 131 FAILED ("EXCEPTION RAISED ON RETURN - (B)"); 132 END IF; 133 WHEN OTHERS => 134 FAILED ("EXCEPTION RAISED - (B)"); 135 END; -- (B) 136 137 --------------------------------------------- 138 139 DECLARE -- (C) 140 141 SUBTYPE INDEX IS INTEGER RANGE 1..5; 142 TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) 143 OF CHARACTER; 144 SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3); 145 AR : ARRAY_TYPE (2..1, 1..3); 146 CALLED : BOOLEAN := FALSE; 147 148 TASK T IS 149 ENTRY E (X : OUT FORMAL); 150 END T; 151 152 TASK BODY T IS 153 BEGIN 154 ACCEPT E (X : OUT FORMAL) DO 155 IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN 156 FAILED ("WRONG BOUNDS PASSED - (C)"); 157 END IF; 158 CALLED := TRUE; 159 X := (2..0 => (1..3 => 'A')); 160 END E; 161 EXCEPTION 162 WHEN OTHERS => 163 FAILED ("EXCEPTION RAISED IN TASK - (C)"); 164 END T; 165 166 BEGIN -- (C) 167 168 T.E (FORMAL (AR)); 169 IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN 170 FAILED ("BOUNDS CHANGED - (C)"); 171 END IF; 172 173 EXCEPTION 174 WHEN CONSTRAINT_ERROR => 175 IF NOT CALLED THEN 176 FAILED ("EXCEPTION RAISED BEFORE CALL - (C)"); 177 ELSE 178 FAILED ("EXCEPTION RAISED ON RETURN - (C)"); 179 END IF; 180 WHEN OTHERS => 181 FAILED ("EXCEPTION RAISED - (C)"); 182 END; -- (C) 183 184 --------------------------------------------- 185 186 DECLARE -- (D) 187 188 SUBTYPE INDEX IS INTEGER RANGE 1..3; 189 TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1) 190 OF CHARACTER; 191 TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER; 192 AR : ACTUAL; 193 CALLED : BOOLEAN := FALSE; 194 195 TASK T IS 196 ENTRY E (X : OUT FORMAL); 197 END T; 198 199 TASK BODY T IS 200 BEGIN 201 ACCEPT E (X : OUT FORMAL) DO 202 IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN 203 FAILED ("WRONG BOUNDS PASSED - (D)"); 204 END IF; 205 CALLED := TRUE; 206 X := (1..3 => (3..1 => 'A')); 207 END E; 208 EXCEPTION 209 WHEN OTHERS => 210 FAILED ("EXCEPTION RAISED IN TASK - (D)"); 211 END T; 212 213 BEGIN -- (D) 214 215 T.E (FORMAL (AR)); 216 IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN 217 FAILED ("BOUNDS CHANGED - (D)"); 218 END IF; 219 220 EXCEPTION 221 WHEN CONSTRAINT_ERROR => 222 IF NOT CALLED THEN 223 FAILED ("EXCEPTION RAISED BEFORE CALL - (D)"); 224 ELSE 225 FAILED ("EXCEPTION RAISED ON RETURN - (D)"); 226 END IF; 227 WHEN OTHERS => 228 FAILED ("EXCEPTION RAISED - (D)"); 229 END; -- (D) 230 231 --------------------------------------------- 232 233 DECLARE -- (E) 234 235 SUBTYPE INDEX IS INTEGER RANGE 1..3; 236 TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) 237 OF CHARACTER; 238 TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2, 239 POSITIVE RANGE 1..3) OF CHARACTER; 240 AR : ACTUAL; 241 CALLED : BOOLEAN := FALSE; 242 243 TASK T IS 244 ENTRY E (X : OUT FORMAL); 245 END T; 246 247 TASK BODY T IS 248 BEGIN 249 ACCEPT E (X : OUT FORMAL) DO 250 IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN 251 FAILED ("WRONG BOUNDS PASSED - (E)"); 252 END IF; 253 CALLED := TRUE; 254 X := (3..1 => (1..3 => ' ' )); 255 END E; 256 EXCEPTION 257 WHEN OTHERS => 258 FAILED ("EXCEPTION RAISED IN TASK - (E)"); 259 END T; 260 261 BEGIN -- (E) 262 263 T.E (FORMAL (AR)); 264 IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN 265 FAILED ("BOUNDS CHANGED - (E)"); 266 END IF; 267 268 EXCEPTION 269 WHEN CONSTRAINT_ERROR => 270 IF NOT CALLED THEN 271 FAILED ("EXCEPTION RAISED BEFORE CALL - (E)"); 272 ELSE 273 FAILED ("EXCEPTION RAISED ON RETURN - (E)"); 274 END IF; 275 WHEN OTHERS => 276 FAILED ("EXCEPTION RAISED - (E)"); 277 END; -- (E) 278 279 --------------------------------------------- 280 281 RESULT; 282END C95086F; 283