1-- C64103B.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, FOR IN-OUT PARAMETERS OF A SCALAR TYPE, 27-- CONSTRAINT_ERROR IS RAISED: 28-- BEFORE A SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL 29-- PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL PARAMETER'S 30-- SUBTYPE; 31-- AFTER A SUBPROGRAM CALL WHEN THE CONVERTED FORMAL PARAMETER 32-- IS OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S SUBTYPE. 33 34-- HISTORY: 35-- CPP 07/18/84 CREATED ORIGINAL TEST. 36-- VCL 10/27/87 MODIFIED THIS HEADER; ADDED STATEMENTS WHICH 37-- REFERENCED THE ACTUAL PARAMETERS IN THE SECOND 38-- SUBTEST. 39 40WITH REPORT; USE REPORT; 41PROCEDURE C64103B IS 42BEGIN 43 TEST ("C64103B", "FOR IN-OUT PARAMETERS OF A SCALAR TYPE, " & 44 "CONSTRAINT_ERROR IS RAISED: BEFORE A " & 45 "SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL " & 46 "PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL " & 47 "PARAMETER'S SUBTYPE; AFTER A SUBPROGRAM " & 48 "CALL WHEN THE CONVERTED FORMAL PARAMETER IS " & 49 "OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S " & 50 "SUBTYPE"); 51 52 53 DECLARE 54 A0 : INTEGER := -9; 55 A1 : INTEGER := IDENT_INT(-1); 56 TYPE SUBINT IS RANGE -8 .. -2; 57 58 TYPE FLOAT_TYPE IS DIGITS 3 RANGE 0.0 .. 3.0; 59 A2 : FLOAT_TYPE := 0.12; 60 A3 : FLOAT_TYPE := 2.5; 61 TYPE NEW_FLOAT IS DIGITS 3 RANGE 1.0 .. 2.0; 62 63 TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0; 64 A4 : FIXED_TYPE := -2.0; 65 A5 : FIXED_TYPE := 4.0; 66 TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0; 67 68 A6 : CHARACTER := 'A'; 69 SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q'; 70 71 TYPE COLOR IS (RED, BURGUNDY, LILAC, MAROON, MAGENTA); 72 SUBTYPE A_COLOR IS COLOR RANGE RED..LILAC; 73 SUBTYPE B_COLOR IS COLOR RANGE MAROON..MAGENTA; 74 A7 : B_COLOR := MAROON; 75 76 PROCEDURE P1 (X : IN OUT SUBINT; 77 S : STRING) IS 78 BEGIN 79 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (A" & 80 S & ")"); 81 END P1; 82 83 PROCEDURE P2 (X : IN OUT NEW_FLOAT; 84 S : STRING) IS 85 BEGIN 86 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A" & 87 S & ")"); 88 END P2; 89 90 PROCEDURE P3 (X : IN OUT NEW_FIXED; 91 S : STRING) IS 92 BEGIN 93 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P3 (A" & 94 S & ")"); 95 END P3; 96 97 PROCEDURE P4 (X : IN OUT SUPER_CHAR; 98 S : STRING) IS 99 BEGIN 100 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P4 (A" & 101 S & ")"); 102 END P4; 103 104 PROCEDURE P5 (X : IN OUT A_COLOR; 105 S : STRING) IS 106 BEGIN 107 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P5 (A" & 108 S & ")"); 109 END P5; 110 BEGIN 111 BEGIN 112 P1 (SUBINT (A0), "1"); 113 EXCEPTION 114 WHEN CONSTRAINT_ERROR => 115 NULL; 116 WHEN OTHERS => 117 FAILED ("WRONG EXCEPTION RAISED -P1 (A1)"); 118 END; 119 120 BEGIN 121 P1 (SUBINT (A1), "2"); 122 EXCEPTION 123 WHEN CONSTRAINT_ERROR => 124 NULL; 125 WHEN OTHERS => 126 FAILED ("WRONG EXCEPTION RAISED -P1 (A2)"); 127 END; 128 129 BEGIN 130 P2 (NEW_FLOAT (A2), "1"); 131 EXCEPTION 132 WHEN CONSTRAINT_ERROR => 133 NULL; 134 WHEN OTHERS => 135 FAILED ("WRONG EXCEPTION RAISED -P2 (A1)"); 136 END; 137 138 BEGIN 139 P2 (NEW_FLOAT (A3), "2"); 140 EXCEPTION 141 WHEN CONSTRAINT_ERROR => 142 NULL; 143 WHEN OTHERS => 144 FAILED ("WRONG EXCEPTION RAISED -P2 (A2)"); 145 END; 146 147 BEGIN 148 P3 (NEW_FIXED (A4), "1"); 149 EXCEPTION 150 WHEN CONSTRAINT_ERROR => 151 NULL; 152 WHEN OTHERS => 153 FAILED ("WRONG EXCEPTION RAISED -P3 (A1)"); 154 END; 155 156 BEGIN 157 P3 (NEW_FIXED (A5), "2"); 158 EXCEPTION 159 WHEN CONSTRAINT_ERROR => 160 NULL; 161 WHEN OTHERS => 162 FAILED ("WRONG EXCEPTION RAISED -P3 (A2)"); 163 END; 164 165 BEGIN 166 P4 (SUPER_CHAR (A6),"1"); 167 EXCEPTION 168 WHEN CONSTRAINT_ERROR => 169 NULL; 170 WHEN OTHERS => 171 FAILED ("WRONG EXCEPTION RAISED -P4 (A1)"); 172 END; 173 174 BEGIN 175 P5 (A_COLOR (A7), "1"); 176 EXCEPTION 177 WHEN CONSTRAINT_ERROR => 178 NULL; 179 WHEN OTHERS => 180 FAILED ("WRONG EXCEPTION RAISED -P5 (A1)"); 181 END; 182 END; 183 184 185 DECLARE 186 CALLED : BOOLEAN; 187 TYPE SUBINT IS RANGE -8 .. -2; 188 A0 : SUBINT := -3; 189 A1 : INTEGER := -9; 190 A2 : INTEGER := -1; 191 192 TYPE FLOAT IS DIGITS 3 RANGE -1.0 .. 2.0; 193 TYPE A_FLOAT IS DIGITS 3 RANGE 0.0 .. 1.0; 194 A3 : A_FLOAT := 1.0; 195 A4 : FLOAT := -0.5; 196 A5 : FLOAT := 1.5; 197 198 TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0; 199 A6 : NEW_FIXED := 0.0; 200 TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0; 201 A7 : FIXED_TYPE := -2.0; 202 A8 : FIXED_TYPE := 4.0; 203 204 SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q'; 205 A9 : SUPER_CHAR := 'C'; 206 A10 : CHARACTER := 'A'; 207 A11 : CHARACTER := 'R'; 208 209 PROCEDURE P1 (X : IN OUT INTEGER; Y : INTEGER) IS 210 BEGIN 211 CALLED := TRUE; 212 X := IDENT_INT (Y); 213 END P1; 214 215 PROCEDURE P2 (X : IN OUT FLOAT; Y : FLOAT) IS 216 BEGIN 217 CALLED := TRUE; 218 X := Y; 219 END P2; 220 221 PROCEDURE P3 ( X : IN OUT FIXED_TYPE; Y : FIXED_TYPE) IS 222 BEGIN 223 CALLED := TRUE; 224 X := Y; 225 END P3; 226 227 PROCEDURE P4 (X : IN OUT CHARACTER; Y : CHARACTER) IS 228 BEGIN 229 CALLED := TRUE; 230 X := IDENT_CHAR(Y); 231 END P4; 232 BEGIN 233 BEGIN 234 CALLED := FALSE; 235 P1 (INTEGER(A0), A1); 236 IF A0 = -3 THEN 237 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)"); 238 ELSE 239 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)"); 240 END IF; 241 EXCEPTION 242 WHEN CONSTRAINT_ERROR => 243 IF NOT CALLED THEN 244 FAILED ("EXCEPTION RAISED BEFORE CALL " & 245 "-P1 (B1)"); 246 END IF; 247 WHEN OTHERS => 248 FAILED ("WRONG EXCEPTION RAISED -P1 (B1)"); 249 END; 250 251 BEGIN 252 CALLED := FALSE; 253 P1 (INTEGER(A0), A2); 254 IF A0 = -3 THEN 255 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B3)"); 256 ELSE 257 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B4)"); 258 END IF; 259 EXCEPTION 260 WHEN CONSTRAINT_ERROR => 261 IF NOT CALLED THEN 262 FAILED ("EXCEPTION RAISED BEFORE CALL " & 263 "-P1 (B2)"); 264 END IF; 265 WHEN OTHERS => 266 FAILED ("WRONG EXCEPTION RAISED -P1 (B2)"); 267 END; 268 269 BEGIN 270 CALLED := FALSE; 271 P2 (FLOAT (A3), A4); 272 IF A3 = 1.0 THEN 273 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)"); 274 ELSE 275 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)"); 276 END IF; 277 EXCEPTION 278 WHEN CONSTRAINT_ERROR => 279 IF NOT CALLED THEN 280 FAILED ("EXCEPTION RAISED BEFORE CALL " & 281 "-P2 (B1)"); 282 END IF; 283 WHEN OTHERS => 284 FAILED ("WRONG EXCEPTION RAISED -P2 (B1)"); 285 END; 286 287 BEGIN 288 CALLED := FALSE; 289 P2 (FLOAT (A3), A5); 290 IF A3 = 1.0 THEN 291 FAILED ("EXCEPTION NOT RAISED -P2 (B3)"); 292 ELSE 293 FAILED ("EXCEPTION NOT RAISED -P2 (B4)"); 294 END IF; 295 EXCEPTION 296 WHEN CONSTRAINT_ERROR => 297 IF NOT CALLED THEN 298 FAILED ("EXCEPTION RAISED BEFORE CALL " & 299 "-P2 (B2)"); 300 END IF; 301 WHEN OTHERS => 302 FAILED ("WRONG EXCEPTION RAISED -P2 (B2)"); 303 END; 304 305 BEGIN 306 CALLED := FALSE; 307 P3 (FIXED_TYPE (A6), A7); 308 IF A6 = 0.0 THEN 309 FAILED ("EXCEPTION NOT RAISED -P3 (B1)"); 310 ELSE 311 FAILED ("EXCEPTION NOT RAISED -P3 (B2)"); 312 END IF; 313 EXCEPTION 314 WHEN CONSTRAINT_ERROR => 315 IF NOT CALLED THEN 316 FAILED ("EXCEPTION RAISED BEFORE CALL " & 317 "-P3 (B1)"); 318 END IF; 319 WHEN OTHERS => 320 FAILED ("WRONG EXCEPTION RAISED -P3 (B1)"); 321 END; 322 323 BEGIN 324 CALLED := FALSE; 325 P3 (FIXED_TYPE (A6), A8); 326 IF A6 = 0.0 THEN 327 FAILED ("EXCEPTION NOT RAISED -P3 (B3)"); 328 ELSE 329 FAILED ("EXCEPTION NOT RAISED -P3 (B4)"); 330 END IF; 331 EXCEPTION 332 WHEN CONSTRAINT_ERROR => 333 IF NOT CALLED THEN 334 FAILED ("EXCEPTION RAISED BEFORE CALL " & 335 "-P3 (B2)"); 336 END IF; 337 WHEN OTHERS => 338 FAILED ("WRONG EXCEPTION RAISED -P3 (B2)"); 339 END; 340 341 BEGIN 342 CALLED := FALSE; 343 P4 (CHARACTER (A9), A10); 344 IF A9 = 'C' THEN 345 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B1)"); 346 ELSE 347 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B2)"); 348 END IF; 349 EXCEPTION 350 WHEN CONSTRAINT_ERROR => 351 IF NOT CALLED THEN 352 FAILED ("EXCEPTION RAISED BEFORE CALL " & 353 "-P4 (B1)"); 354 END IF; 355 WHEN OTHERS => 356 FAILED ("WRONG EXCEPTION RAISED -P4 (B1)"); 357 END; 358 359 BEGIN 360 CALLED := FALSE; 361 P4 (CHARACTER (A9), A11); 362 IF A9 = 'C' THEN 363 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B3)"); 364 ELSE 365 FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B4)"); 366 END IF; 367 EXCEPTION 368 WHEN CONSTRAINT_ERROR => 369 IF NOT CALLED THEN 370 FAILED ("EXCEPTION RAISED BEFORE CALL " & 371 "-P4 (B2)"); 372 END IF; 373 WHEN OTHERS => 374 FAILED ("WRONG EXCEPTION RAISED -P4 (B2)"); 375 END; 376 END; 377 378 RESULT; 379END C64103B; 380