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