1-- C95067A.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 A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A 26-- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE. 27 28-- JWC 6/20/85 29 30WITH REPORT; USE REPORT; 31PROCEDURE C95067A IS 32 33 PACKAGE PKG IS 34 35 TYPE ITYPE IS LIMITED PRIVATE; 36 37 TASK T1 IS 38 39 ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING); 40 41 ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER; 42 M : STRING); 43 44 ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER); 45 46 END T1; 47 48 SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20; 49 TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE; 50 51 TASK T2 IS 52 53 ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; 54 I : INTEGER; S : STRING; M : STRING); 55 56 ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER; 57 I : INTEGER; S : STRING; 58 M : STRING); 59 60 ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER; 61 I : INTEGER; S : STRING); 62 63 END T2; 64 65 PRIVATE 66 67 TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99; 68 69 TYPE VRTYPE (C : INT_0_20 := 20) IS 70 RECORD 71 I : INTEGER; 72 S : STRING (1 .. C); 73 END RECORD; 74 75 END PKG; 76 77 USE PKG; 78 79 I1 : ITYPE; 80 81 TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE; 82 83 A1 : ATYPE; 84 85 VR1 : VRTYPE; 86 87 D : CONSTANT INT_0_20 := 10; 88 89 TYPE RTYPE IS 90 RECORD 91 J : ITYPE; 92 R : VRTYPE (D); 93 END RECORD; 94 95 R1 : RTYPE; 96 97 PACKAGE BODY PKG IS 98 99 TASK BODY T1 IS 100 BEGIN 101 LOOP 102 SELECT 103 ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER; 104 M : STRING) DO 105 IF INTEGER (X) /= V THEN 106 FAILED ("WRONG SCALAR VALUE - " & M); 107 END IF; 108 END LOOK_IN_I; 109 OR 110 ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE; 111 V : INTEGER; 112 M : STRING) DO 113 IF INTEGER (X) /= V THEN 114 FAILED ("WRONG SCALAR VALUE - " & M); 115 END IF; 116 END LOOK_INOUT_I; 117 OR 118 ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO 119 X := ITYPE (IDENT_INT (V)); 120 END SET_I; 121 OR 122 TERMINATE; 123 END SELECT; 124 END LOOP; 125 END T1; 126 127 TASK BODY T2 IS 128 BEGIN 129 LOOP 130 SELECT 131 ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; 132 I : INTEGER; S : STRING; 133 M : STRING) DO 134 IF (X.C /= C OR X.I /= I) OR ELSE 135 X.S /= S THEN 136 FAILED ("WRONG COMPOSITE VALUE - " & 137 M); 138 END IF; 139 END LOOK_IN_VR; 140 OR 141 ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE; 142 C : INTEGER; I : INTEGER; 143 S : STRING; 144 M : STRING) DO 145 IF (X.C /= C OR X.I /= I) OR ELSE 146 X.S /= S THEN 147 FAILED ("WRONG COMPOSITE VALUE - " & 148 M); 149 END IF; 150 END LOOK_INOUT_VR; 151 OR 152 ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER; 153 I : INTEGER; S : STRING) DO 154 X := (IDENT_INT(C), IDENT_INT(I), 155 IDENT_STR(S)); 156 END SET_VR; 157 OR 158 TERMINATE; 159 END SELECT; 160 END LOOP; 161 END T2; 162 163 BEGIN 164 I1 := ITYPE (IDENT_INT(2)); 165 166 FOR I IN A1'RANGE LOOP 167 A1 (I) := ITYPE (3 + IDENT_INT(I)); 168 END LOOP; 169 170 VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234")); 171 172 R1.J := ITYPE (IDENT_INT(6)); 173 R1.R := (IDENT_INT(D), IDENT_INT(19), 174 IDENT_STR("ABCDEFGHIJ")); 175 END PKG; 176 177 TASK T3 IS 178 ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING); 179 180 ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER; 181 NV : INTEGER; M : STRING); 182 183 ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING); 184 185 ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER; 186 NV : INTEGER; M : STRING); 187 188 ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER; 189 S : STRING; M : STRING); 190 191 ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE; 192 OC : INTEGER; OI : INTEGER; OS : STRING; 193 NC : INTEGER; NI : INTEGER; NS : STRING; 194 M : STRING); 195 196 ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER; 197 I : INTEGER; S : STRING; M : STRING); 198 199 ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER; 200 OC : INTEGER; OI : INTEGER; OS : STRING; 201 NJ : INTEGER; 202 NC : INTEGER; NI : INTEGER; NS : STRING; 203 M : STRING); 204 END T3; 205 206 TASK BODY T3 IS 207 BEGIN 208 ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO 209 T1.LOOK_IN_I (X, V, M); 210 END CHECK_IN_I; 211 212 ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER; 213 NV : INTEGER; M : STRING) DO 214 T1.LOOK_INOUT_I (X, OV, M & " - A"); 215 T1.SET_I (X, NV); 216 T1.LOOK_INOUT_I (X, NV, M & " - B"); 217 T1.LOOK_IN_I (X, NV, M & " - C"); 218 END CHECK_INOUT_I; 219 220 ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO 221 FOR I IN X'RANGE LOOP 222 T1.LOOK_IN_I (X(I), V+I, M & " -" & 223 INTEGER'IMAGE (I)); 224 END LOOP; 225 END CHECK_IN_A; 226 227 ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER; 228 NV : INTEGER; M : STRING) DO 229 FOR I IN X'RANGE LOOP 230 T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" & 231 INTEGER'IMAGE (I)); 232 T1.SET_I (X(I), NV+I); 233 T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" & 234 INTEGER'IMAGE (I)); 235 T1.LOOK_IN_I (X(I), NV+I, M & " - C" & 236 INTEGER'IMAGE (I)); 237 END LOOP; 238 END CHECK_INOUT_A; 239 240 ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER; 241 S : STRING; M : STRING) DO 242 T2.LOOK_IN_VR (X, C, I, S, M); 243 END CHECK_IN_VR; 244 245 ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE; 246 OC : INTEGER; OI : INTEGER; 247 OS : STRING; 248 NC : INTEGER; NI : INTEGER; 249 NS : STRING; 250 M : STRING) DO 251 T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A"); 252 T2.SET_VR (X, NC, NI, NS); 253 T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B"); 254 T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C"); 255 END CHECK_INOUT_VR; 256 257 ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER; 258 I : INTEGER; S : STRING; M : STRING) DO 259 T1.LOOK_IN_I (X.J, J, M & " - A"); 260 T2.LOOK_IN_VR (X.R, C, I, S, M & " - B"); 261 END CHECK_IN_R; 262 263 ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER; 264 OC : INTEGER; OI : INTEGER; OS : STRING; 265 NJ : INTEGER; 266 NC : INTEGER; NI : INTEGER; NS : STRING; 267 M : STRING) DO 268 T1.LOOK_INOUT_I (X.J, OJ, M & " - A"); 269 T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B"); 270 T1.SET_I (X.J, NJ); 271 T2.SET_VR (X.R, NC, NI, NS); 272 T1.LOOK_INOUT_I (X.J, NJ, M & " - C"); 273 T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D"); 274 T1.LOOK_IN_I (X.J, NJ, M & " - E"); 275 T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F"); 276 END CHECK_INOUT_R; 277 END T3; 278 279BEGIN 280 TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " & 281 "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS"); 282 283 T3.CHECK_IN_I (I1, 2, "IN I"); 284 285 T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I"); 286 287 T3.CHECK_IN_A (A1, 3, "IN A"); 288 289 T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A"); 290 291 T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR"); 292 293 T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210", 294 "INOUT VR"); 295 296 T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R"); 297 298 T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, 299 "ZYXWVUTSRQ", "INOUT R"); 300 301 RESULT; 302END C95067A; 303