1-- C95087B.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 ENTRY FORMAL PARAMETERS OF UNCONSTRAINED 26-- RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT 27-- CONSTRAINTS RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE 28-- THE CONSTRAINT OF THE ACTUAL PARAMETER. 29-- SUBTESTS ARE: 30-- (A) RECORD TYPE. 31-- (B) PRIVATE TYPE. 32-- (C) LIMITED PRIVATE TYPE. 33 34-- RJW 1/10/86 35 36WITH REPORT; USE REPORT; 37PROCEDURE C95087B IS 38 39BEGIN 40 41 TEST ( "C95087B", "CHECK ASSIGNMENT TO ENTRY FORMAL PARAMETERS " & 42 "OF UNCONSTRAINED TYPE (WITH NO DEFAULT)" ); 43 44 -------------------------------------------------- 45 46 DECLARE -- (A) 47 48 PACKAGE PKG IS 49 50 TYPE RECTYPE (CONSTRAINT : INTEGER) IS 51 RECORD 52 INTFIELD : INTEGER; 53 STRFIELD : STRING (1..CONSTRAINT); 54 END RECORD; 55 56 TASK T IS 57 ENTRY E (REC9 : OUT RECTYPE; 58 REC6 : IN OUT RECTYPE); 59 END T; 60 61 END PKG; 62 63 REC9 : PKG.RECTYPE(IDENT_INT(9)) := 64 (IDENT_INT(9), 9, "123456789"); 65 REC6 : PKG.RECTYPE(IDENT_INT(6)) := 66 (IDENT_INT(6), 5, "AEIOUY"); 67 68 PACKAGE BODY PKG IS 69 70 TASK BODY T IS 71 72 REC4 : CONSTANT RECTYPE(IDENT_INT(4)) := 73 (IDENT_INT(4), 4, "OOPS"); 74 75 BEGIN 76 ACCEPT E (REC9 : OUT RECTYPE; 77 REC6 : IN OUT RECTYPE) DO 78 79 BEGIN -- (A.1) 80 REC9 := REC6; 81 FAILED ("CONSTRAINT_ERROR NOT RAISED " & 82 "- A.1"); 83 EXCEPTION 84 WHEN CONSTRAINT_ERROR => 85 NULL; 86 WHEN OTHERS => 87 FAILED ("WRONG EXCEPTION RAISED " & 88 "- A.1"); 89 END; -- (A.1) 90 91 BEGIN -- (A.2) 92 REC6 := REC4; 93 FAILED ("CONSTRAINT_ERROR NOT RAISED " & 94 "- A.2"); 95 EXCEPTION 96 WHEN CONSTRAINT_ERROR => 97 NULL; 98 WHEN OTHERS => 99 FAILED ("WRONG EXCEPTION RAISED " & 100 "- A.2"); 101 END; -- (A.2) 102 103 REC9 := (IDENT_INT(9), 9, "987654321"); 104 105 END E; 106 END T; 107 END PKG; 108 109 BEGIN -- (A) 110 111 PKG.T.E (REC9, REC6); 112 113 IF REC9.STRFIELD /= IDENT_STR("987654321") THEN 114 FAILED ("ASSIGNMENT TO REC9 FAILED - (A)"); 115 END IF; 116 117 END; -- (A) 118 119 -------------------------------------------------- 120 121 DECLARE -- (B) 122 123 PACKAGE PKG IS 124 125 TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE; 126 127 TASK T IS 128 ENTRY E (REC9 : OUT RECTYPE; 129 REC6 : IN OUT RECTYPE); 130 END T; 131 132 PRIVATE 133 TYPE RECTYPE (CONSTRAINT : INTEGER) IS 134 RECORD 135 INTFIELD : INTEGER; 136 STRFIELD : STRING (1..CONSTRAINT); 137 END RECORD; 138 END PKG; 139 140 REC9 : PKG.RECTYPE(9); 141 REC6 : PKG.RECTYPE(6); 142 143 PACKAGE BODY PKG IS 144 145 TASK BODY T IS 146 147 REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS"); 148 149 BEGIN 150 ACCEPT E (REC9 : OUT RECTYPE; 151 REC6 : IN OUT RECTYPE) DO 152 153 BEGIN -- (B.1) 154 REC9 := REC6; 155 FAILED ("CONSTRAINT_ERROR NOT RAISED " & 156 "- B.1"); 157 EXCEPTION 158 WHEN CONSTRAINT_ERROR => 159 NULL; 160 WHEN OTHERS => 161 FAILED ("WRONG EXCEPTION RAISED " & 162 "- B.1"); 163 END; -- (B.1) 164 165 BEGIN -- (B.2) 166 REC6 := REC4; 167 FAILED ("CONSTRAINT_ERROR NOT RAISED " & 168 "- B.2"); 169 EXCEPTION 170 WHEN CONSTRAINT_ERROR => 171 NULL; 172 WHEN OTHERS => 173 FAILED ("WRONG EXCEPTION RAISED " & 174 "- B.2"); 175 END; -- (B.2) 176 177 END E; 178 END T; 179 180 BEGIN 181 REC9 := (9, 9, "123456789"); 182 REC6 := (6, 5, "AEIOUY"); 183 END PKG; 184 185 BEGIN -- (B) 186 187 PKG.T.E (REC9, REC6); 188 189 END; -- (B) 190 191 -------------------------------------------------- 192 193 DECLARE -- (C) 194 195 PACKAGE PKG IS 196 197 TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE; 198 199 TASK T IS 200 ENTRY E (REC9 : OUT RECTYPE; 201 REC6 : IN OUT RECTYPE); 202 END T; 203 204 PRIVATE 205 TYPE RECTYPE (CONSTRAINT : INTEGER) IS 206 RECORD 207 INTFIELD : INTEGER; 208 STRFIELD : STRING (1..CONSTRAINT); 209 END RECORD; 210 END PKG; 211 212 REC6 : PKG.RECTYPE(IDENT_INT(6)); 213 REC9 : PKG.RECTYPE(IDENT_INT(9)); 214 215 PACKAGE BODY PKG IS 216 217 TASK BODY T IS 218 219 REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS"); 220 221 BEGIN 222 ACCEPT E (REC9 : OUT RECTYPE; 223 REC6 : IN OUT RECTYPE) DO 224 225 BEGIN -- (C.1) 226 REC9 := REC6; 227 FAILED ("CONSTRAINT_ERROR NOT RAISED " & 228 "- C.1"); 229 EXCEPTION 230 WHEN CONSTRAINT_ERROR => 231 NULL; 232 WHEN OTHERS => 233 FAILED ("WRONG EXCEPTION RAISED " & 234 "- C.1"); 235 END; -- (C.1) 236 237 BEGIN -- (C.2) 238 REC6 := REC4; 239 FAILED ("CONSTRAINT_ERROR NOT RAISED " & 240 "- C.2"); 241 EXCEPTION 242 WHEN CONSTRAINT_ERROR => 243 NULL; 244 WHEN OTHERS => 245 FAILED ("WRONG EXCEPTION RAISED " & 246 "- C.2"); 247 END; -- (C.2) 248 249 END E; 250 END T; 251 252 BEGIN 253 REC6 := (6, 5, "AEIOUY"); 254 REC9 := (9, 9, "123456789"); 255 END PKG; 256 257 BEGIN -- (C) 258 259 PKG.T.E (REC9, REC6); 260 261 END; -- (C) 262 263 -------------------------------------------------- 264 265 RESULT; 266 267END C95087B; 268