1-- C45282B.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 IN AND NOT IN ARE EVALUATED CORRECTLY FOR : 26-- D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH 27-- DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE 28-- TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE; 29-- E) ACCESS TO TASK TYPES. 30 31-- TBN 8/8/86 32 33WITH REPORT; USE REPORT; 34PROCEDURE C45282B IS 35 36 SUBTYPE INT IS INTEGER RANGE 1 .. 5; 37 38 PACKAGE P IS 39 TYPE PRI_REC1 (D : INT) IS PRIVATE; 40 TYPE PRI_REC2 (D : INT := 2) IS PRIVATE; 41 FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1; 42 FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2; 43 TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE; 44 TYPE ACC_LIM1 IS ACCESS LIM_REC1; 45 SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2); 46 PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING); 47 TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE; 48 TYPE ACC_LIM2 IS ACCESS LIM_REC2; 49 SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2); 50 PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING); 51 PRIVATE 52 TYPE PRI_REC1 (D : INT) IS 53 RECORD 54 STR : STRING (1 .. D); 55 END RECORD; 56 TYPE PRI_REC2 (D : INT := 2) IS 57 RECORD 58 STR : STRING (1 .. D); 59 END RECORD; 60 TYPE LIM_REC1 (D : INT) IS 61 RECORD 62 STR : STRING (1 .. D); 63 END RECORD; 64 TYPE LIM_REC2 (D : INT := 2) IS 65 RECORD 66 STR : STRING (1 .. D); 67 END RECORD; 68 END P; 69 70 USE P; 71 72 TYPE DIS_REC1 (D : INT) IS 73 RECORD 74 STR : STRING (1 .. D); 75 END RECORD; 76 TYPE DIS_REC2 (D : INT := 5) IS 77 RECORD 78 STR : STRING (D .. 8); 79 END RECORD; 80 81 TYPE ACC1_REC1 IS ACCESS DIS_REC1; 82 SUBTYPE ACC2_REC1 IS ACC1_REC1 (2); 83 TYPE ACC1_REC2 IS ACCESS DIS_REC2; 84 SUBTYPE ACC2_REC2 IS ACC1_REC2 (2); 85 REC1 : ACC1_REC1; 86 REC2 : ACC2_REC1; 87 REC3 : ACC1_REC2; 88 REC4 : ACC2_REC2; 89 TYPE ACC_PREC1 IS ACCESS PRI_REC1; 90 SUBTYPE ACC_SREC1 IS ACC_PREC1 (2); 91 REC5 : ACC_PREC1; 92 REC6 : ACC_SREC1; 93 TYPE ACC_PREC2 IS ACCESS PRI_REC2; 94 SUBTYPE ACC_SREC2 IS ACC_PREC2 (2); 95 REC7 : ACC_PREC2; 96 REC8 : ACC_SREC2; 97 REC9 : ACC_LIM1; 98 REC10 : ACC_SUB_LIM1; 99 REC11 : ACC_LIM2; 100 REC12 : ACC_SUB_LIM2; 101 102 TASK TYPE T IS 103 ENTRY E (X : INTEGER); 104 END T; 105 106 TASK BODY T IS 107 BEGIN 108 ACCEPT E (X : INTEGER) DO 109 IF X /= IDENT_INT(1) THEN 110 FAILED ("INCORRECT VALUE PASSED TO TASK"); 111 END IF; 112 END E; 113 END T; 114 115 PACKAGE BODY P IS 116 FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS 117 REC : PRI_REC1 (A); 118 BEGIN 119 REC := (A, B); 120 RETURN (REC); 121 END INIT_PREC1; 122 123 FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS 124 REC : PRI_REC2; 125 BEGIN 126 REC := (A, B); 127 RETURN (REC); 128 END INIT_PREC2; 129 130 PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS 131 BEGIN 132 A.ALL := (B, C); 133 END ASSIGN_LIM1; 134 135 PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS 136 BEGIN 137 A.ALL := (B, C); 138 END ASSIGN_LIM2; 139 END P; 140 141BEGIN 142 143 TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " & 144 "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " & 145 "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " & 146 "TASK TYPES"); 147 148-- CASE D 149------------------------------------------------------------------------ 150 IF REC1 NOT IN ACC1_REC1 THEN 151 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1"); 152 END IF; 153 IF REC1 IN ACC2_REC1 THEN 154 NULL; 155 ELSE 156 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2"); 157 END IF; 158 IF REC2 NOT IN ACC1_REC1 THEN 159 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3"); 160 END IF; 161 REC1 := NEW DIS_REC1'(5, "12345"); 162 IF REC1 IN ACC1_REC1 THEN 163 NULL; 164 ELSE 165 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4"); 166 END IF; 167 IF REC1 IN ACC2_REC1 THEN 168 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5"); 169 END IF; 170 REC2 := NEW DIS_REC1'(2, "HI"); 171 IF REC2 IN ACC1_REC1 THEN 172 NULL; 173 ELSE 174 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6"); 175 END IF; 176 177------------------------------------------------------------------------ 178 179 IF REC3 IN ACC1_REC2 THEN 180 NULL; 181 ELSE 182 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7"); 183 END IF; 184 IF REC3 NOT IN ACC2_REC2 THEN 185 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8"); 186 END IF; 187 IF REC4 IN ACC1_REC2 THEN 188 NULL; 189 ELSE 190 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9"); 191 END IF; 192 REC3 := NEW DIS_REC2'(5, "5678"); 193 IF REC3 IN ACC1_REC2 THEN 194 NULL; 195 ELSE 196 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10"); 197 END IF; 198 IF REC3 IN ACC2_REC2 THEN 199 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11"); 200 END IF; 201 REC4 := NEW DIS_REC2'(2, "2345678"); 202 IF REC4 IN ACC1_REC2 THEN 203 NULL; 204 ELSE 205 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12"); 206 END IF; 207 IF REC4 NOT IN ACC2_REC2 THEN 208 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13"); 209 END IF; 210 211------------------------------------------------------------------------ 212 213 IF REC5 NOT IN ACC_PREC1 THEN 214 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14"); 215 END IF; 216 IF REC5 NOT IN ACC_SREC1 THEN 217 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15"); 218 END IF; 219 IF REC6 NOT IN ACC_PREC1 THEN 220 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16"); 221 END IF; 222 REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345")); 223 IF REC5 IN ACC_PREC1 THEN 224 NULL; 225 ELSE 226 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17"); 227 END IF; 228 IF REC5 IN ACC_SREC1 THEN 229 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18"); 230 END IF; 231 REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI")); 232 IF REC6 IN ACC_PREC1 THEN 233 NULL; 234 ELSE 235 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19"); 236 END IF; 237 238------------------------------------------------------------------------ 239 240 IF REC7 NOT IN ACC_PREC2 THEN 241 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20"); 242 END IF; 243 IF REC7 NOT IN ACC_SREC2 THEN 244 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21"); 245 END IF; 246 IF REC8 NOT IN ACC_PREC2 THEN 247 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22"); 248 END IF; 249 REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345")); 250 IF REC7 IN ACC_PREC2 THEN 251 NULL; 252 ELSE 253 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23"); 254 END IF; 255 IF REC7 IN ACC_SREC2 THEN 256 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24"); 257 END IF; 258 REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI")); 259 IF REC8 IN ACC_PREC2 THEN 260 NULL; 261 ELSE 262 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25"); 263 END IF; 264 265------------------------------------------------------------------------ 266 267 IF REC9 NOT IN ACC_LIM1 THEN 268 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26"); 269 END IF; 270 IF REC9 NOT IN ACC_SUB_LIM1 THEN 271 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27"); 272 END IF; 273 IF REC10 NOT IN ACC_LIM1 THEN 274 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28"); 275 END IF; 276 REC9 := NEW LIM_REC1 (5); 277 ASSIGN_LIM1 (REC9, 5, "12345"); 278 IF REC9 IN ACC_LIM1 THEN 279 NULL; 280 ELSE 281 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29"); 282 END IF; 283 IF REC9 IN ACC_SUB_LIM1 THEN 284 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30"); 285 END IF; 286 REC10 := NEW LIM_REC1 (2); 287 ASSIGN_LIM1 (REC10, 2, "12"); 288 IF REC10 IN ACC_LIM1 THEN 289 NULL; 290 ELSE 291 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31"); 292 END IF; 293 294------------------------------------------------------------------------ 295 296 IF REC11 NOT IN ACC_LIM2 THEN 297 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32"); 298 END IF; 299 IF REC11 NOT IN ACC_SUB_LIM2 THEN 300 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33"); 301 END IF; 302 IF REC12 NOT IN ACC_LIM2 THEN 303 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34"); 304 END IF; 305 REC11 := NEW LIM_REC2; 306 IF REC11 NOT IN ACC_SUB_LIM2 THEN 307 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35"); 308 END IF; 309 ASSIGN_LIM2 (REC11, 2, "12"); 310 IF REC11 IN ACC_LIM2 THEN 311 NULL; 312 ELSE 313 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36"); 314 END IF; 315 IF REC11 IN ACC_SUB_LIM2 THEN 316 NULL; 317 ELSE 318 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37"); 319 END IF; 320 REC12 := NEW LIM_REC2; 321 ASSIGN_LIM2 (REC12, 2, "12"); 322 IF REC12 IN ACC_LIM2 THEN 323 NULL; 324 ELSE 325 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38"); 326 END IF; 327 328-- CASE E 329------------------------------------------------------------------------ 330 DECLARE 331 TYPE ACC_TASK IS ACCESS T; 332 T1 : ACC_TASK; 333 BEGIN 334 IF T1 NOT IN ACC_TASK THEN 335 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39"); 336 END IF; 337 T1 := NEW T; 338 IF T1 IN ACC_TASK THEN 339 NULL; 340 ELSE 341 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38"); 342 END IF; 343 T1.E (1); 344 END; 345 346 RESULT; 347END C45282B; 348