1-- C47009B.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-- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN ACCESS 27-- TYPE, CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE VALUE 28-- OF THE OPERAND IS NULL. 29 30-- HISTORY: 31-- RJW 07/23/86 CREATED ORIGINAL TEST. 32-- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. CHANGED 33-- CONSTRAINTS OF B SUBTYPES TO VALUES WHICH ARE 34-- CLOSER TO THE VALUES OF THE A SUBTYPES. INDENTED 35-- THE EXCEPTION STATEMENTS IN SUBTEST 11. 36 37WITH REPORT; USE REPORT; 38PROCEDURE C47009B IS 39 40BEGIN 41 42 TEST( "C47009B", "WHEN THE TYPE MARK IN A QUALIFIED " & 43 "EXPRESSION DENOTES AN ACCESS TYPE, " & 44 "CHECK THAT CONSTRAINT_ERROR IS NOT " & 45 "RAISED WHEN THE VALUE OF THE OPERAND IS NULL" ); 46 47 DECLARE 48 49 TYPE ACC1 IS ACCESS BOOLEAN; 50 A : ACC1; 51 52 BEGIN 53 A := ACC1'(NULL); 54 EXCEPTION 55 WHEN CONSTRAINT_ERROR => 56 FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC1" ); 57 WHEN OTHERS => 58 FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC1" ); 59 END; 60 61 DECLARE 62 63 TYPE ACC2 IS ACCESS INTEGER; 64 A : ACC2; 65 66 BEGIN 67 A := ACC2'(NULL); 68 EXCEPTION 69 WHEN CONSTRAINT_ERROR => 70 FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC2" ); 71 WHEN OTHERS => 72 FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC2" ); 73 END; 74 75 DECLARE 76 77 TYPE CHAR IS ('A', 'B'); 78 TYPE ACC3 IS ACCESS CHAR; 79 A : ACC3; 80 81 BEGIN 82 A := ACC3'(NULL); 83 EXCEPTION 84 WHEN CONSTRAINT_ERROR => 85 FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC3" ); 86 WHEN OTHERS => 87 FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC3" ); 88 END; 89 90 DECLARE 91 92 TYPE FLOAT1 IS DIGITS 5 RANGE -1.0 .. 1.0; 93 TYPE ACC4 IS ACCESS FLOAT1; 94 A : ACC4; 95 96 BEGIN 97 A := ACC4'(NULL); 98 EXCEPTION 99 WHEN CONSTRAINT_ERROR => 100 FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC4" ); 101 WHEN OTHERS => 102 FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC4" ); 103 END; 104 105 DECLARE 106 107 TYPE FIXED IS DELTA 0.5 RANGE -1.0 .. 1.0; 108 TYPE ACC5 IS ACCESS FIXED; 109 A : ACC5; 110 111 BEGIN 112 A := ACC5'(NULL); 113 EXCEPTION 114 WHEN CONSTRAINT_ERROR => 115 FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC5" ); 116 WHEN OTHERS => 117 FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC5" ); 118 END; 119 120 DECLARE 121 122 TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; 123 TYPE ACC6 IS ACCESS ARR; 124 SUBTYPE ACC6A IS ACC6 (IDENT_INT (1) .. IDENT_INT (5)); 125 SUBTYPE ACC6B IS ACC6 (IDENT_INT (2) .. IDENT_INT (10)); 126 A : ACC6A; 127 B : ACC6B; 128 129 BEGIN 130 A := ACC6A'(B); 131 EXCEPTION 132 WHEN CONSTRAINT_ERROR => 133 FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & 134 "TYPE ACC6" ); 135 WHEN OTHERS => 136 FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & 137 "TYPE ACC6" ); 138 END; 139 140 DECLARE 141 142 TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 143 OF INTEGER; 144 TYPE ACC7 IS ACCESS ARR; 145 SUBTYPE ACC7A IS ACC7 (IDENT_INT (1) .. IDENT_INT (5), 146 IDENT_INT (1) .. IDENT_INT (1)); 147 SUBTYPE ACC7B IS ACC7 (IDENT_INT (1) .. IDENT_INT (15), 148 IDENT_INT (1) .. IDENT_INT (10)); 149 A : ACC7A; 150 B : ACC7B; 151 152 BEGIN 153 A := ACC7A'(B); 154 EXCEPTION 155 WHEN CONSTRAINT_ERROR => 156 FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & 157 "TYPE ACC7" ); 158 WHEN OTHERS => 159 FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & 160 "TYPE ACC7" ); 161 END; 162 163 DECLARE 164 165 TYPE REC (D : INTEGER) IS 166 RECORD 167 NULL; 168 END RECORD; 169 170 TYPE ACC8 IS ACCESS REC; 171 SUBTYPE ACC8A IS ACC8 (IDENT_INT (5)); 172 SUBTYPE ACC8B IS ACC8 (IDENT_INT (6)); 173 A : ACC8A; 174 B : ACC8B; 175 176 BEGIN 177 A := ACC8A'(B); 178 EXCEPTION 179 WHEN CONSTRAINT_ERROR => 180 FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & 181 "TYPE ACC8" ); 182 WHEN OTHERS => 183 FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & 184 "TYPE ACC8" ); 185 END; 186 187 DECLARE 188 189 TYPE REC (D1,D2 : INTEGER) IS 190 RECORD 191 NULL; 192 END RECORD; 193 194 TYPE ACC9 IS ACCESS REC; 195 SUBTYPE ACC9A IS ACC9 (IDENT_INT (4), IDENT_INT (5)); 196 SUBTYPE ACC9B IS ACC9 (IDENT_INT (5), IDENT_INT (4)); 197 A : ACC9A; 198 B : ACC9B; 199 200 BEGIN 201 A := ACC9A'(B); 202 EXCEPTION 203 WHEN CONSTRAINT_ERROR => 204 FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & 205 "TYPE ACC9" ); 206 WHEN OTHERS => 207 FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & 208 "TYPE ACC9" ); 209 END; 210 211 DECLARE 212 213 PACKAGE PKG IS 214 TYPE REC (D : INTEGER) IS PRIVATE; 215 216 PRIVATE 217 TYPE REC (D : INTEGER) IS 218 RECORD 219 NULL; 220 END RECORD; 221 222 END PKG; 223 224 USE PKG; 225 226 TYPE ACC10 IS ACCESS REC; 227 SUBTYPE ACC10A IS ACC10 (IDENT_INT (10)); 228 SUBTYPE ACC10B IS ACC10 (IDENT_INT (9)); 229 A : ACC10A; 230 B : ACC10B; 231 232 BEGIN 233 A := ACC10A'(B); 234 EXCEPTION 235 WHEN CONSTRAINT_ERROR => 236 FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " & 237 "TYPE ACC10" ); 238 WHEN OTHERS => 239 FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & 240 "TYPE ACC10" ); 241 END; 242 243 DECLARE 244 245 PACKAGE PKG1 IS 246 TYPE REC (D : INTEGER) IS LIMITED PRIVATE; 247 248 PRIVATE 249 TYPE REC (D : INTEGER) IS 250 RECORD 251 NULL; 252 END RECORD; 253 END PKG1; 254 255 PACKAGE PKG2 IS END PKG2; 256 257 PACKAGE BODY PKG2 IS 258 USE PKG1; 259 260 TYPE ACC11 IS ACCESS REC; 261 SUBTYPE ACC11A IS ACC11 (IDENT_INT (11)); 262 SUBTYPE ACC11B IS ACC11 (IDENT_INT (12)); 263 A : ACC11A; 264 B : ACC11B; 265 266 BEGIN 267 A := ACC11A'(B); 268 EXCEPTION 269 WHEN CONSTRAINT_ERROR => 270 FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF" & 271 " TYPE ACC11" ); 272 WHEN OTHERS => 273 FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " & 274 "TYPE ACC11" ); 275 END PKG2; 276 277 BEGIN 278 NULL; 279 END; 280 281 RESULT; 282END C47009B; 283