1-- C36204C.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 THE 'RANGE ATTRIBUTE CAN BE USED TO DECLARE OBJECTS 27-- AND IN A SUBTYPE AND TYPE DECLARATION. 28 29-- HISTORY: 30-- LB 08/13/86 CREATED ORIGINAL TEST. 31-- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. 32-- REARRANGED STATEMENTS SO TEST IS CALLED FIRST. 33-- ELIMINATED DEAD VARIABLE OPTIMIZATION. CHECKED 34-- RANGE VALUES FOR A SMALL INTEGER. 35 36WITH REPORT; USE REPORT; 37PROCEDURE C36204C IS 38 39BEGIN 40 TEST("C36204C","USING 'RANGE TO DECLARE OBJECTS AND " & 41 "IN A SUBTYPE AND TYPE DECLARATION " & 42 "RETURNS THE CORRECT VALUES."); 43 44 DECLARE 45 46 ARR : ARRAY(IDENT_INT(4) .. IDENT_INT(10)) OF INTEGER; 47 OBJ1 : ARRAY(ARR'RANGE) OF BOOLEAN; 48 49 SUBTYPE SMALL_INT IS INTEGER RANGE ARR'RANGE ; 50 SML : SMALL_INT; 51 52 TYPE OTHER_ARR IS ARRAY(ARR'RANGE) OF CHARACTER; 53 OBJ2 : OTHER_ARR; 54 55 TYPE ARR_TYPE IS ARRAY(INTEGER RANGE IDENT_INT(1) .. 56 IDENT_INT(10)) OF INTEGER; 57 TYPE ARR_PTR IS ACCESS ARR_TYPE; 58 PTR : ARR_PTR := NEW ARR_TYPE'(ARR_TYPE'RANGE => 0); 59 60 FUNCTION F RETURN ARR_TYPE IS 61 AR : ARR_TYPE := (ARR_TYPE'RANGE => 0); 62 BEGIN 63 RETURN AR; 64 END F; 65 66 BEGIN 67 BEGIN 68 IF OBJ1'FIRST /= IDENT_INT(4) THEN 69 FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " & 70 "DECLARATION 1"); 71 END IF; 72 EXCEPTION 73 WHEN OTHERS => 74 FAILED("EXCEPTION RAISED WHEN CHECKING " & 75 "OBJECT DECLARATION 1"); 76 END; 77 78 BEGIN 79 IF OBJ1'LAST /= IDENT_INT(10) THEN 80 FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " & 81 "DECLARATION 2"); 82 END IF; 83 EXCEPTION 84 WHEN OTHERS => 85 FAILED("EXCEPTION RAISED WHEN CHECKING " & 86 "OBJECT DECLARATION 2"); 87 END; 88 89 BEGIN 90 IF SMALL_INT'FIRST /= 4 THEN 91 FAILED("INCORRECT RANGE VALUE FOR A SMALL " & 92 "INTEGER DECLARATION 1"); 93 END IF; 94 EXCEPTION 95 WHEN OTHERS => 96 FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" & 97 " INTEGER DECLARATION 1"); 98 END; 99 100 BEGIN 101 IF SMALL_INT'LAST /= 10 THEN 102 FAILED("INCORRECT RANGE VALUE FOR A SMALL " & 103 "INTEGER DECLARATION 2"); 104 END IF; 105 EXCEPTION 106 WHEN OTHERS => 107 FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" & 108 " INTEGER DECLARATION 2"); 109 END; 110 111 BEGIN 112 SML := IDENT_INT(3) ; 113 IF SML = 3 THEN 114 COMMENT("VARIABLE SML OPTIMIZED VALUE 1"); 115 END IF; 116 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " & 117 "VALUE 1"); 118 EXCEPTION 119 WHEN CONSTRAINT_ERROR => 120 NULL; 121 WHEN OTHERS => 122 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " & 123 "RANGE VALUE 1"); 124 END; 125 126 BEGIN 127 SML := IDENT_INT(11) ; 128 IF SML = 11 THEN 129 COMMENT("VARIABLE SML OPTIMIZED VALUE 2"); 130 END IF; 131 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " & 132 "VALUE 2"); 133 EXCEPTION 134 WHEN CONSTRAINT_ERROR => 135 NULL; 136 WHEN OTHERS => 137 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " & 138 "RANGE VALUE 2"); 139 END; 140 141 BEGIN 142 IF OBJ2'FIRST /= IDENT_INT(4) THEN 143 FAILED("INCORRECT RANGE VALUE FOR A TYPE " & 144 "DECLARATION 1"); 145 END IF; 146 EXCEPTION 147 WHEN OTHERS => 148 FAILED("EXCEPTION RAISED WHEN CHECKING A " & 149 "TYPE DECLARATION 1"); 150 END; 151 152 BEGIN 153 IF OBJ2'LAST /= IDENT_INT(10) THEN 154 FAILED("INCORRECT RANGE VALUE FOR A TYPE " & 155 "DECLARATION 2"); 156 END IF; 157 EXCEPTION 158 WHEN OTHERS => 159 FAILED("EXCEPTION RAISED WHEN CHECKING A " & 160 "TYPE DECLARATION 2"); 161 END; 162 163 BEGIN 164 IF PTR'FIRST /= IDENT_INT(1) THEN 165 FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " & 166 "TYPE DECLARATION 1"); 167 END IF; 168 EXCEPTION 169 WHEN OTHERS => 170 FAILED("EXCEPTION RAISED WHEN CHECKING AN " & 171 "ACCESS TYPE DECLARATION 1"); 172 END; 173 174 BEGIN 175 IF PTR'LAST /= IDENT_INT(10) THEN 176 FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " & 177 "TYPE DECLARATION 2"); 178 END IF; 179 EXCEPTION 180 WHEN OTHERS => 181 FAILED("EXCEPTION RAISED WHEN CHECKING AN " & 182 "ACCESS TYPE DECLARATION 2"); 183 END; 184 185 DECLARE 186 OBJ_F1 : INTEGER RANGE F'RANGE ; 187 BEGIN 188 OBJ_F1 := IDENT_INT(0) ; 189 IF OBJ_F1 = 0 THEN 190 COMMENT("VARIABLE OBJ_F1 OPTIMIZED VALUE 1"); 191 END IF; 192 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " & 193 "VALUE 3"); 194 EXCEPTION 195 WHEN CONSTRAINT_ERROR => 196 NULL; 197 WHEN OTHERS => 198 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " & 199 "RANGE VALUE 3"); 200 END; 201 202 DECLARE 203 OBJ_F2 : INTEGER RANGE F'RANGE ; 204 BEGIN 205 OBJ_F2 := IDENT_INT(11) ; 206 IF OBJ_F2 = 11 THEN 207 COMMENT("VARIABLE OBJ_F2 OPTIMIZED VALUE 1"); 208 END IF; 209 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " & 210 "VALUE 4"); 211 EXCEPTION 212 WHEN CONSTRAINT_ERROR => 213 NULL; 214 WHEN OTHERS => 215 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " & 216 "RANGE VALUE 4"); 217 END; 218 END; 219 RESULT; 220 221END C36204C; 222