1-- C95072B.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 PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE 26-- PASSED BY COPY FOR ALL MODES. 27-- SUBTESTS ARE: 28-- (A) PRIVATE SCALAR PARAMETERS TO ENTRIES. 29-- (B) PRIVATE ACCESS PARAMETERS TO ENTRIES. 30 31-- JWC 7/22/85 32 33WITH REPORT; USE REPORT; 34PROCEDURE C95072B IS 35 36BEGIN 37 TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " & 38 "PARAMETERS ARE COPIED"); 39 40 --------------------------------------------------- 41 42 DECLARE -- (A) 43 44 PACKAGE SCALAR_PKG IS 45 46 TYPE T IS PRIVATE; 47 C0 : CONSTANT T; 48 C1 : CONSTANT T; 49 C10 : CONSTANT T; 50 C100 : CONSTANT T; 51 52 FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T; 53 FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER; 54 55 PRIVATE 56 57 TYPE T IS NEW INTEGER; 58 C0 : CONSTANT T := 0; 59 C1 : CONSTANT T := 1; 60 C10 : CONSTANT T := 10; 61 C100 : CONSTANT T := 100; 62 63 END SCALAR_PKG; 64 65 PACKAGE BODY SCALAR_PKG IS 66 67 FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS 68 BEGIN 69 RETURN T (INTEGER(OLD) + INTEGER(INCREMENT)); 70 END "+"; 71 72 FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS 73 BEGIN 74 RETURN INTEGER (OLD_PRIVATE); 75 END CONVERT; 76 77 END SCALAR_PKG; 78 79 USE SCALAR_PKG; 80 81 BEGIN -- (A) 82 83 DECLARE -- (A1) 84 85 I : T; 86 E : EXCEPTION; 87 88 TASK TA IS 89 ENTRY EA (EI : IN T; EO : OUT T; 90 EIO : IN OUT T); 91 END TA; 92 93 TASK BODY TA IS 94 95 TEMP : T; 96 97 BEGIN 98 99 ACCEPT EA (EI : IN T; EO : OUT T; 100 EIO : IN OUT T) DO 101 102 TEMP := EI; -- SAVE VALUE OF EI AT ACCEPT. 103 104 EO := C10; 105 IF EI /= TEMP THEN 106 FAILED ("ASSIGNMENT TO PRIVATE " & 107 "(SCALAR) OUT PARAMETER " & 108 "CHANGES THE VALUE OF INPUT " & 109 "PARAMETER"); 110 TEMP := EI; -- RESET TEMP FOR NEXT CASE. 111 END IF; 112 113 EIO := EIO + C100; 114 IF EI /= TEMP THEN 115 FAILED ("ASSIGNMENT TO PRIVATE " & 116 "(SCALAR) IN OUT PARAMETER " & 117 "CHANGES THE VALUE OF INPUT " & 118 "PARAMETER"); 119 TEMP := EI; -- RESET TEMP FOR NEXT CASE. 120 END IF; 121 122 I := I + C1; 123 IF EI /= TEMP THEN 124 FAILED ("ASSIGNMENT TO PRIVATE " & 125 "(SCALAR) ACTUAL PARAMETER " & 126 "CHANGES THE VALUE OF " & 127 "INPUT PARAMETER"); 128 END IF; 129 130 RAISE E; -- CHECK EXCEPTION 131 -- HANDLING. 132 END EA; 133 134 EXCEPTION 135 WHEN OTHERS => NULL; 136 END TA; 137 138 BEGIN -- (A1) 139 140 I := C0; -- INITIALIZE I SO VARIOUS CASES CAN BE 141 -- DETECTED. 142 TA.EA (I, I, I); 143 FAILED ("EXCEPTION NOT RAISED - A"); 144 145 EXCEPTION 146 WHEN E => 147 IF I /= C1 THEN 148 CASE CONVERT (I) IS 149 WHEN 11 => 150 FAILED ("OUT ACTUAL PRIVATE " & 151 "(SCALAR) PARAMETER " & 152 "CHANGED GLOBAL VALUE"); 153 WHEN 101 => 154 FAILED ("IN OUT ACTUAL PRIVATE " & 155 "(SCALAR) PARAMETER " & 156 "CHANGED GLOBAL VALUE"); 157 WHEN 111 => 158 FAILED ("OUT AND IN OUT ACTUAL " & 159 "PRIVATE (SCALAR) " & 160 "PARAMETER CHANGED " & 161 "GLOBAL VALUE"); 162 WHEN OTHERS => 163 FAILED ("UNDETERMINED CHANGE TO " & 164 "GLOBAL VALUE"); 165 END CASE; 166 END IF; 167 WHEN OTHERS => 168 FAILED ("WRONG EXCEPTION RAISED - A"); 169 END; -- (A1) 170 171 END; -- (A) 172 173 --------------------------------------------------- 174 175 DECLARE -- (B) 176 177 PACKAGE ACCESS_PKG IS 178 179 TYPE T IS PRIVATE; 180 C_NULL : CONSTANT T; 181 C1 : CONSTANT T; 182 C10 : CONSTANT T; 183 C100 : CONSTANT T; 184 C101 : CONSTANT T; 185 186 PRIVATE 187 188 TYPE T IS ACCESS INTEGER; 189 C_NULL : CONSTANT T := NULL; 190 C1 : CONSTANT T := NEW INTEGER'(1); 191 C10 : CONSTANT T := NEW INTEGER'(10); 192 C100 : CONSTANT T := NEW INTEGER'(100); 193 C101 : CONSTANT T := NEW INTEGER'(101); 194 195 END ACCESS_PKG; 196 197 USE ACCESS_PKG; 198 199 BEGIN -- (B) 200 201 DECLARE -- (B1) 202 203 I : T; 204 E : EXCEPTION; 205 206 TASK TB IS 207 ENTRY EB (EI : IN T; EO : OUT T; 208 EIO : IN OUT T); 209 END TB; 210 211 TASK BODY TB IS 212 213 TEMP : T; 214 215 BEGIN 216 217 ACCEPT EB (EI : IN T; EO : OUT T; 218 EIO : IN OUT T) DO 219 220 TEMP := EI; -- SAVE VALUE OF EI AT ACCEPT. 221 222 I := C101; 223 IF EI /= TEMP THEN 224 FAILED ("ASSIGNMENT TO PRIVATE " & 225 "(ACCESS) ACTUAL VARIABLE " & 226 "CHANGES THE VALUE OF INPUT " & 227 "PARAMETER"); 228 TEMP := EI; -- RESET TEMP FOR NEXT CASE. 229 END IF; 230 231 EO := C1; 232 IF EI /= TEMP THEN 233 FAILED ("ASSIGNMENT TO PRIVATE " & 234 "(ACCESS) OUT PARAMETER " & 235 "CHANGES THE VALUE OF INPUT " & 236 "PARAMETER"); 237 TEMP := EI; -- RESET TEMP FOR NEXT CASE. 238 END IF; 239 240 EIO := C10; 241 IF EI /= TEMP THEN 242 FAILED ("ASSIGNMENT TO PRIVATE " & 243 "(ACCESS) IN OUT PARAMETER " & 244 "CHANGES THE VALUE OF INPUT " & 245 "PARAMETER"); 246 END IF; 247 248 RAISE E; -- CHECK EXCEPTION 249 -- HANDLING. 250 END EB; 251 252 EXCEPTION 253 WHEN OTHERS => NULL; 254 END TB; 255 256 BEGIN -- (B1) 257 258 I := C100; 259 TB.EB (I, I, I); 260 FAILED ("EXCEPTION NOT RAISED - B"); 261 262 EXCEPTION 263 WHEN E => 264 IF I /= C101 THEN 265 FAILED ("OUT OR IN OUT ACTUAL ENTRY " & 266 "PARAMETER VALUE CHANGED DESPITE " & 267 "RAISED EXCEPTION"); 268 END IF; 269 WHEN OTHERS => 270 FAILED ("WRONG EXCEPTION RAISED - B"); 271 END; -- (B1) 272 273 END; -- (B) 274 275 --------------------------------------------------- 276 277 RESULT; 278END C95072B; 279