1-- C74203A.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 MEMBERSHIP TESTS, QUALIFICATION, AND EXPLICIT 27-- CONVERSION ARE AVAILABLE FOR LIMITED AND NON-LIMITED PRIVATE 28-- TYPES. INCLUDE TYPES WITH DISCRIMINANTS AND TYPES 29-- WITH LIMITED COMPONENTS. 30 31-- HISTORY: 32-- BCB 03/10/88 CREATED ORIGINAL TEST. 33 34WITH REPORT; USE REPORT; 35 36PROCEDURE C74203A IS 37 38 PACKAGE PP IS 39 TYPE LIM IS LIMITED PRIVATE; 40 PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER); 41 42 TYPE A IS PRIVATE; 43 SUBTYPE SUBA IS A; 44 A1 : CONSTANT A; 45 46 TYPE B IS LIMITED PRIVATE; 47 B1 : CONSTANT B; 48 49 TYPE C IS PRIVATE; 50 C1 : CONSTANT C; 51 52 TYPE D IS LIMITED PRIVATE; 53 D1 : CONSTANT D; 54 55 TYPE E (DISC1 : INTEGER := 5) IS PRIVATE; 56 SUBTYPE SUBE IS E; 57 E1 : CONSTANT E; 58 59 TYPE F (DISC2 : INTEGER := 15) IS LIMITED PRIVATE; 60 F1 : CONSTANT F; 61 62 TYPE G (DISC3 : INTEGER) IS PRIVATE; 63 G1 : CONSTANT G; 64 65 TYPE H (DISC4 : INTEGER) IS LIMITED PRIVATE; 66 H1 : CONSTANT H; 67 68 TYPE I IS RECORD 69 COMPI : LIM; 70 END RECORD; 71 SUBTYPE SUBI IS I; 72 73 TYPE J IS ARRAY(1..5) OF LIM; 74 SUBTYPE SUBJ IS J; 75 76 TYPE S1 IS (VINCE, TOM, PHIL, JODIE, ROSA, TERESA); 77 TYPE S2 IS (THIS, THAT, THESE, THOSE, THEM); 78 TYPE S3 IS RANGE 1 .. 100; 79 TYPE S4 IS RANGE 1 .. 100; 80 PRIVATE 81 TYPE LIM IS RANGE 1 .. 100; 82 83 TYPE A IS (RED, BLUE, GREEN, YELLOW, BLACK, WHITE); 84 A1 : CONSTANT A := BLUE; 85 86 TYPE B IS (ONE, TWO, THREE, FOUR, FIVE, SIX); 87 B1 : CONSTANT B := THREE; 88 89 TYPE C IS RANGE 1 .. 100; 90 C1 : CONSTANT C := 50; 91 92 TYPE D IS RANGE 1 .. 100; 93 D1 : CONSTANT D := 50; 94 95 TYPE E (DISC1 : INTEGER := 5) IS RECORD 96 COMPE : S1; 97 END RECORD; 98 E1 : CONSTANT E := (DISC1 => 5, COMPE => TOM); 99 100 TYPE F (DISC2 : INTEGER := 15) IS RECORD 101 COMPF : S2; 102 END RECORD; 103 F1 : CONSTANT F := (DISC2 => 15, COMPF => THAT); 104 105 TYPE G (DISC3 : INTEGER) IS RECORD 106 COMPG : S3; 107 END RECORD; 108 G1 : CONSTANT G := (DISC3 => 25, COMPG => 50); 109 110 TYPE H (DISC4 : INTEGER) IS RECORD 111 COMPH : S4; 112 END RECORD; 113 H1 : CONSTANT H := (DISC4 => 30, COMPH => 50); 114 END PP; 115 116 USE PP; 117 118 AVAR : SUBA := A1; 119 EVAR : SUBE := E1; 120 121 IVAR : SUBI; 122 JVAR : SUBJ; 123 124 PACKAGE BODY PP IS 125 PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER) IS 126 BEGIN 127 Z1 := LIM (Z2); 128 END INIT; 129 BEGIN 130 NULL; 131 END PP; 132 133 PROCEDURE QUAL_PRIV (W : A) IS 134 BEGIN 135 NULL; 136 END QUAL_PRIV; 137 138 PROCEDURE QUAL_LIM_PRIV (X : B) IS 139 BEGIN 140 NULL; 141 END QUAL_LIM_PRIV; 142 143 PROCEDURE EXPL_CONV_PRIV_1 (Y : C) IS 144 BEGIN 145 NULL; 146 END EXPL_CONV_PRIV_1; 147 148 PROCEDURE EXPL_CONV_LIM_PRIV_1 (Z : D) IS 149 BEGIN 150 NULL; 151 END EXPL_CONV_LIM_PRIV_1; 152 153 PROCEDURE EXPL_CONV_PRIV_2 (Y2 : G) IS 154 BEGIN 155 NULL; 156 END EXPL_CONV_PRIV_2; 157 158 PROCEDURE EXPL_CONV_LIM_PRIV_2 (Z2 : H) IS 159 BEGIN 160 NULL; 161 END EXPL_CONV_LIM_PRIV_2; 162 163 PROCEDURE EXPL_CONV_PRIV_3 (Y3 : I) IS 164 BEGIN 165 NULL; 166 END EXPL_CONV_PRIV_3; 167 168 PROCEDURE EXPL_CONV_PRIV_4 (Y4 : J) IS 169 BEGIN 170 NULL; 171 END EXPL_CONV_PRIV_4; 172 173BEGIN 174 TEST ("C74203A", "CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, " & 175 "AND EXPLICIT CONVERSION ARE AVAILABLE FOR " & 176 "LIMITED AND NON-LIMITED PRIVATE TYPES. " & 177 "INCLUDE TYPES WITH DISCRIMINANTS AND " & 178 "TYPES WITH LIMITED COMPONENTS"); 179 180 INIT (IVAR.COMPI, 50); 181 182 FOR K IN IDENT_INT (1) .. IDENT_INT (5) LOOP 183 INIT (JVAR(K), 25); 184 END LOOP; 185 186 IF NOT (AVAR IN A) THEN 187 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " & 188 "PRIVATE TYPE - 1"); 189 END IF; 190 191 IF (AVAR NOT IN A) THEN 192 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " & 193 "PRIVATE TYPE - 1"); 194 END IF; 195 196 IF NOT (B1 IN B) THEN 197 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " & 198 "LIMITED PRIVATE TYPE - 1"); 199 END IF; 200 201 IF (B1 NOT IN B) THEN 202 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " & 203 "LIMITED PRIVATE TYPE - 1"); 204 END IF; 205 206 QUAL_PRIV (A'(AVAR)); 207 208 QUAL_LIM_PRIV (B'(B1)); 209 210 EXPL_CONV_PRIV_1 (C(C1)); 211 212 EXPL_CONV_LIM_PRIV_1 (D(D1)); 213 214 IF NOT (EVAR IN E) THEN 215 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " & 216 "PRIVATE TYPE - 2"); 217 END IF; 218 219 IF (EVAR NOT IN E) THEN 220 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " & 221 "PRIVATE TYPE - 2"); 222 END IF; 223 224 IF NOT (F1 IN F) THEN 225 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " & 226 "LIMITED PRIVATE TYPE - 2"); 227 END IF; 228 229 IF (F1 NOT IN F) THEN 230 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " & 231 "LIMITED PRIVATE TYPE - 2"); 232 END IF; 233 234 EXPL_CONV_PRIV_2 (G(G1)); 235 236 EXPL_CONV_LIM_PRIV_2 (H(H1)); 237 238 IF NOT (IVAR IN I) THEN 239 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " & 240 "PRIVATE TYPE - 3"); 241 END IF; 242 243 IF (IVAR NOT IN I) THEN 244 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " & 245 "PRIVATE TYPE - 3"); 246 END IF; 247 248 EXPL_CONV_PRIV_3 (I(IVAR)); 249 250 IF NOT (JVAR IN J) THEN 251 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " & 252 "PRIVATE TYPE - 4"); 253 END IF; 254 255 IF (JVAR NOT IN J) THEN 256 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " & 257 "PRIVATE TYPE - 4"); 258 END IF; 259 260 EXPL_CONV_PRIV_4 (J(JVAR)); 261 262 RESULT; 263END C74203A; 264