1-- C43215A.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 A POSITIONAL 26-- ARRAY AGGREGATE WHOSE UPPER BOUND EXCEEDS THE UPPER BOUND 27-- OF THE INDEX SUBTYPE BUT BELONGS TO THE INDEX BASE TYPE. 28 29-- EG 02/13/84 30 31WITH REPORT; 32WITH SYSTEM; 33 34PROCEDURE C43215A IS 35 36 USE REPORT; 37 USE SYSTEM; 38 39BEGIN 40 41 TEST("C43215A","CHECK THAT CONSTRAINT_ERROR IS RAISED " & 42 "FOR A POSITIONAL ARRAY AGGREGATE WHOSE " & 43 "UPPER BOUND EXCEEDS THE UPPER BOUND OF THE " & 44 "INDEX SUBTYPE BUT BELONGS TO THE INDEX " & 45 "BASE TYPE"); 46 47 BEGIN 48 49CASE_A : DECLARE 50 51 LOWER_BOUND : CONSTANT := MAX_INT-3; 52 UPPER_BOUND : CONSTANT := MAX_INT-1; 53 54 TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND; 55 56 TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER; 57 58 A1 : TA(STA); 59 OK : EXCEPTION; 60 61 FUNCTION FUN1 RETURN TA IS 62 BEGIN 63 RETURN (1, 2, 3, 4); 64 EXCEPTION 65 WHEN CONSTRAINT_ERROR => 66 BEGIN 67 COMMENT ("CASE A : CONSTRAINT_ERROR RAISED"); 68 RAISE OK; 69 END; 70 WHEN OTHERS => 71 BEGIN 72 FAILED ("CASE A : EXCEPTION RAISED IN FUN1"); 73 RAISE OK; 74 END; 75 END FUN1; 76 77 BEGIN 78 79 A1 := FUN1; 80 FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED"); 81 82 EXCEPTION 83 84 WHEN OK => 85 NULL; 86 87 WHEN OTHERS => 88 FAILED ("CASE A : EXCEPTION RAISED"); 89 90 END CASE_A; 91 92CASE_B : DECLARE 93 94 TYPE ENUM IS (A, B, C, D); 95 96 SUBTYPE STB IS ENUM RANGE A .. C; 97 98 TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER; 99 100 B1 : TB(STB); 101 OK : EXCEPTION; 102 103 FUNCTION FUN1 RETURN TB IS 104 BEGIN 105 RETURN (1, 2, 3, 4); 106 EXCEPTION 107 WHEN CONSTRAINT_ERROR => 108 BEGIN 109 COMMENT ("CASE B : CONSTRAINT_ERROR RAISED"); 110 RAISE OK; 111 END; 112 WHEN OTHERS => 113 BEGIN 114 FAILED ("CASE B : EXCEPTION RAISED IN FUN1"); 115 RAISE OK; 116 END; 117 END FUN1; 118 119 BEGIN 120 121 B1 := FUN1; 122 FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED"); 123 124 EXCEPTION 125 126 WHEN OK => 127 NULL; 128 129 WHEN OTHERS => 130 FAILED ("CASE B : EXCEPTION RAISED"); 131 132 END CASE_B; 133 134 END; 135 136 RESULT; 137 138END C43215A; 139