1-- C64106C.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 ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED 26-- RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT 27-- CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS 28-- CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING 29-- ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER. 30 31-- SUBTESTS ARE: 32-- (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE. 33-- (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE. 34-- (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE. 35 36-- DAS 1/16/81 37-- VKG 1/7/83 38-- CPP 8/9/84 39 40WITH REPORT; 41PROCEDURE C64106C IS 42 43 USE REPORT; 44 45BEGIN 46 47 TEST ("C64106C", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " & 48 "UNCONSTRAINED TYPES (WITH DEFAULTS)"); 49 50 -------------------------------------------------- 51 52 DECLARE -- (A) 53 54 PACKAGE PKG IS 55 56 SUBTYPE INTRANGE IS INTEGER RANGE 0..31; 57 58 TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS 59 RECORD 60 INTFLD : INTRANGE; 61 STRFLD : STRING(1..CONSTRAINT); 62 END RECORD; 63 64 REC91,REC92,REC93 : RECTYPE(9); 65 REC_OOPS : RECTYPE(4); 66 67 PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE; 68 REC3 : OUT RECTYPE); 69 END PKG; 70 71 PACKAGE BODY PKG IS 72 73 PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE; 74 REC3 : OUT RECTYPE) IS 75 76 PROCEDURE P1 (REC11 : IN RECTYPE; 77 REC12 : IN OUT RECTYPE; 78 REC13 : OUT RECTYPE) IS 79 BEGIN 80 IF (NOT REC11'CONSTRAINED) OR 81 (REC11.CONSTRAINT /= IDENT_INT(9)) THEN 82 FAILED ("CONSTRAINT ON RECORD " & 83 "TYPE IN PARAMETER " & 84 "NOT RECOGNIZED"); 85 END IF; 86 87 BEGIN -- ASSIGNMENT TO IN OUT PARAMETER 88 REC12 := REC_OOPS; 89 FAILED ("CONSTRAINT ERROR NOT RAISED - " & 90 "A.1"); 91 EXCEPTION 92 WHEN CONSTRAINT_ERROR => 93 NULL; 94 WHEN OTHERS => 95 FAILED ("WRONG EXCEPTION RAISED - " & 96 "A.1"); 97 END; 98 99 BEGIN -- ASSIGNMENT TO OUT PARAMETER 100 REC13 := REC_OOPS; 101 FAILED ("CONSTRAINT_ERROR NOT RAISED - " & 102 "A.2"); 103 EXCEPTION 104 WHEN CONSTRAINT_ERROR => 105 NULL; 106 WHEN OTHERS => 107 FAILED ("WRONG EXCEPTION RAISED - " & 108 "A.2"); 109 END; 110 END P1; 111 112 BEGIN 113 P1 (REC1, REC2, REC3); 114 END P; 115 116 BEGIN 117 118 REC91 := (9, 9, "123456789"); 119 REC92 := REC91; 120 REC93 := REC91; 121 122 REC_OOPS := (4, 4, "OOPS"); 123 124 END PKG; 125 126 BEGIN -- (A) 127 128 PKG.P (PKG.REC91, PKG.REC92, PKG.REC93); 129 130 END; -- (A) 131 132 -------------------------------------------------- 133 134 DECLARE -- (B) 135 136 PACKAGE PKG IS 137 138 SUBTYPE INTRANGE IS INTEGER RANGE 0..31; 139 140 TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE; 141 142 PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE; 143 REC3 : OUT RECTYPE); 144 145 PRIVATE 146 147 TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS 148 RECORD 149 INTFLD : INTRANGE; 150 STRFLD : STRING(1..CONSTRAINT); 151 END RECORD; 152 END PKG; 153 154 REC91, REC92, REC93 : PKG.RECTYPE(9); 155 REC_OOPS : PKG.RECTYPE(4); 156 157 PACKAGE BODY PKG IS 158 159 PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE; 160 REC3 : OUT RECTYPE) IS 161 162 PROCEDURE P1 (REC11 : IN RECTYPE; 163 REC12 : IN OUT RECTYPE; 164 REC13 : OUT RECTYPE) IS 165 BEGIN 166 IF (NOT REC11'CONSTRAINED) OR 167 (REC11.CONSTRAINT /= IDENT_INT(9)) THEN 168 FAILED ("CONSTRAINT ON PRIVATE " & 169 "TYPE IN PARAMETER " & 170 "NOT RECOGNIZED"); 171 END IF; 172 173 BEGIN -- ASSIGNMENT TO IN OUT PARAMETER 174 REC12 := REC_OOPS; 175 FAILED ("CONSTRAINT ERROR NOT RAISED - " & 176 "B.1"); 177 EXCEPTION 178 WHEN CONSTRAINT_ERROR => 179 NULL; 180 WHEN OTHERS => 181 FAILED ("WRONG EXCEPTION RAISED - " & 182 "B.1"); 183 END; 184 185 BEGIN -- ASSIGNMENT TO OUT PARAMETER 186 REC13 := REC_OOPS; 187 FAILED ("CONSTRAINT_ERROR NOT RAISED - " & 188 "B.2"); 189 EXCEPTION 190 WHEN CONSTRAINT_ERROR => 191 NULL; 192 WHEN OTHERS => 193 FAILED ("WRONG EXCEPTION RAISED - " & 194 "B.2"); 195 END; 196 END P1; 197 198 BEGIN 199 P1 (REC1, REC2, REC3); 200 END P; 201 202 BEGIN 203 204 REC91 := (9, 9, "123456789"); 205 REC92 := REC91; 206 REC93 := REC91; 207 208 REC_OOPS := (4, 4, "OOPS"); 209 210 END PKG; 211 212 BEGIN -- (B) 213 214 PKG.P (REC91, REC92, REC93); 215 216 END; -- (B) 217 218 -------------------------------------------------- 219 220 DECLARE -- (C) 221 222 PACKAGE PKG IS 223 224 SUBTYPE INTRANGE IS INTEGER RANGE 0..31; 225 226 TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS 227 LIMITED PRIVATE; 228 229 PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE; 230 REC3 : OUT RECTYPE); 231 232 PRIVATE 233 234 TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS 235 RECORD 236 INTFLD : INTRANGE; 237 STRFLD : STRING(1..CONSTRAINT); 238 END RECORD; 239 END PKG; 240 241 REC91,REC92,REC93 : PKG.RECTYPE(9); 242 REC_OOPS : PKG.RECTYPE(4); 243 244 PACKAGE BODY PKG IS 245 246 PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE; 247 REC3 : OUT RECTYPE) IS 248 249 PROCEDURE P1 (REC11 : IN RECTYPE; 250 REC12 : IN OUT RECTYPE; 251 REC13 : OUT RECTYPE) IS 252 BEGIN 253 IF (NOT REC11'CONSTRAINED) OR 254 (REC11.CONSTRAINT /= 9) THEN 255 FAILED ("CONSTRAINT ON LIMITED PRIVATE " & 256 "TYPE IN PARAMETER " & 257 "NOT RECOGNIZED"); 258 END IF; 259 260 BEGIN -- ASSIGNMENT TO IN OUT PARAMETER 261 REC12 := REC_OOPS; 262 FAILED ("CONSTRAINT ERROR NOT RAISED - " & 263 "C.1"); 264 EXCEPTION 265 WHEN CONSTRAINT_ERROR => 266 NULL; 267 WHEN OTHERS => 268 FAILED ("WRONG EXCEPTION RAISED - " & 269 "C.1"); 270 END; 271 272 BEGIN -- ASSIGNMENT TO OUT PARAMETER 273 REC13 := REC_OOPS; 274 FAILED ("CONSTRAINT_ERROR NOT RAISED - " & 275 "C.2"); 276 EXCEPTION 277 WHEN CONSTRAINT_ERROR => 278 NULL; 279 WHEN OTHERS => 280 FAILED ("WRONG EXCEPTION RAISED - " & 281 "C.2"); 282 END; 283 END P1; 284 285 BEGIN 286 P1 (REC1, REC2, REC3); 287 END P; 288 289 BEGIN 290 291 REC91 := (9, 9, "123456789"); 292 REC92 := REC91; 293 REC93 := REC91; 294 295 REC_OOPS := (4, 4, "OOPS"); 296 297 END PKG; 298 299 BEGIN -- (C) 300 301 PKG.P (REC91, REC92, REC93); 302 303 END; -- (C) 304 305 -------------------------------------------------- 306 307 RESULT; 308 309END C64106C; 310