1-- C32001E.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 IN MULTIPLE OBJECT DECLARATIONS FOR PRIVATE TYPES, THE 26-- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED 27-- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE 28-- INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE EVALUATIONS 29-- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS. 30 31-- RJW 7/18/86 32 33WITH REPORT; USE REPORT; 34 35PROCEDURE C32001E IS 36 37 BUMP : ARRAY (1 .. 10) OF INTEGER := (OTHERS => 0); 38 G1 : ARRAY (5 .. 6) OF INTEGER; 39 40 FUNCTION F (I : INTEGER) RETURN INTEGER IS 41 BEGIN 42 BUMP (I) := BUMP (I) + 1; 43 RETURN BUMP (I); 44 END F; 45 46 FUNCTION G (I : INTEGER) RETURN INTEGER IS 47 BEGIN 48 BUMP (I) := BUMP (I) + 1; 49 G1 (I) := BUMP (I); 50 RETURN BUMP (I); 51 END G; 52 53BEGIN 54 TEST ("C32001E", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 55 "FOR PRIVATE TYPES, THE SUBTYPE INDICATION " & 56 "AND THE INITIALIZATION EXPRESSIONS ARE " & 57 "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & 58 "IS DECLARED AND THE SUBTYPE INDICATION IS " & 59 "EVALUATED FIRST. ALSO, CHECK THAT THE " & 60 "EVALUATIONS YIELD THE SAME RESULT AS A " & 61 "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); 62 63 DECLARE 64 PACKAGE PKG1 IS 65 TYPE PBOOL IS PRIVATE; 66 TYPE PINT IS PRIVATE; 67 TYPE PREC (D : INTEGER) IS PRIVATE; 68 TYPE PARR IS PRIVATE; 69 TYPE PACC IS PRIVATE; 70 71 FUNCTION INIT1 (I : INTEGER) RETURN PBOOL; 72 FUNCTION INIT2 (I : INTEGER) RETURN PINT; 73 FUNCTION INIT3 (I : INTEGER) RETURN PREC; 74 FUNCTION INIT4 (I : INTEGER) RETURN PARR; 75 FUNCTION INIT5 (I : INTEGER) RETURN PACC; 76 77 PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING); 78 PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING); 79 PROCEDURE CHECK3 (R : PREC; I, J : INTEGER; 80 S : STRING); 81 PROCEDURE CHECK4 (A : PARR; I, J : INTEGER; 82 S : STRING); 83 PROCEDURE CHECK5 (V : PACC; S : STRING); 84 PROCEDURE CHECK6 (V : PACC; S : STRING); 85 86 PRIVATE 87 TYPE PBOOL IS NEW BOOLEAN; 88 TYPE PINT IS NEW INTEGER; 89 90 TYPE PREC (D : INTEGER) IS 91 RECORD 92 VALUE : INTEGER; 93 END RECORD; 94 95 TYPE PARR IS ARRAY (1 .. 2) OF INTEGER; 96 97 TYPE VECTOR IS ARRAY (NATURAL RANGE <>) OF INTEGER; 98 TYPE PACC IS ACCESS VECTOR; 99 END PKG1; 100 101 PACKAGE BODY PKG1 IS 102 FUNCTION INIT1 (I : INTEGER) RETURN PBOOL IS 103 BEGIN 104 RETURN PBOOL'VAL (F (I) - 1); 105 END INIT1; 106 107 FUNCTION INIT2 (I : INTEGER) RETURN PINT IS 108 BEGIN 109 RETURN PINT'VAL (F (I)); 110 END INIT2; 111 112 FUNCTION INIT3 (I : INTEGER) RETURN PREC IS 113 PR : PREC (G1 (I)) := (G1 (I), F (I)); 114 BEGIN 115 RETURN PR; 116 END INIT3; 117 118 FUNCTION INIT4 (I : INTEGER) RETURN PARR IS 119 PA : PARR := (1 .. 2 => F (I)); 120 BEGIN 121 RETURN PA; 122 END INIT4; 123 124 FUNCTION INIT5 (I : INTEGER) RETURN PACC IS 125 ACCV : PACC := NEW VECTOR'(1 .. F (I) => F (I)); 126 BEGIN 127 RETURN ACCV; 128 END INIT5; 129 130 PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING) IS 131 BEGIN 132 IF B /= PBOOL'VAL (I) THEN 133 FAILED ( S & " HAS AN INCORRECT VALUE OF " & 134 PBOOL'IMAGE (B)); 135 END IF; 136 END CHECK1; 137 138 PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING) IS 139 BEGIN 140 IF I /= PINT'VAL (J) THEN 141 FAILED ( S & " HAS AN INCORRECT VALUE OF " & 142 PINT'IMAGE (I)); 143 END IF; 144 END CHECK2; 145 146 PROCEDURE CHECK3 (R : PREC; I, J : INTEGER; 147 S : STRING) IS 148 BEGIN 149 IF R.D /= I THEN 150 FAILED ( S & ".D HAS AN INCORRECT VALUE OF " 151 & INTEGER'IMAGE (R.D)); 152 END IF; 153 154 IF R.VALUE /= J THEN 155 FAILED ( S & ".VALUE HAS AN INCORRECT " & 156 "VALUE OF " & 157 INTEGER'IMAGE (R.VALUE)); 158 END IF; 159 END CHECK3; 160 161 PROCEDURE CHECK4 (A : PARR; I, J : INTEGER; 162 S : STRING) IS 163 BEGIN 164 IF A /= (I, J) AND A /= (J, I) THEN 165 FAILED ( S & " HAS AN INCORRECT VALUE" ); 166 END IF; 167 END CHECK4; 168 169 PROCEDURE CHECK5 (V : PACC; S : STRING) IS 170 BEGIN 171 IF V'LAST /= 1 THEN 172 FAILED ( S & " HAS AN INCORRECT UPPER BOUND " 173 & "OF " & INTEGER'IMAGE (V'LAST)); 174 END IF; 175 176 IF V (1) /= 2 THEN 177 FAILED ( S & " HAS AN INCORRECT COMPONENT " & 178 "VALUE" ); 179 END IF; 180 END CHECK5; 181 182 PROCEDURE CHECK6 (V : PACC; S : STRING) IS 183 BEGIN 184 IF V'LAST /= 3 THEN 185 FAILED ( S & " HAS AN INCORRECT UPPER BOUND " 186 & "OF " & INTEGER'IMAGE (V'LAST)); 187 END IF; 188 189 IF V.ALL = (4, 5, 6) OR V.ALL = (5, 4, 6) OR 190 V.ALL = (4, 6, 5) OR V.ALL = (6, 4, 5) OR 191 V.ALL = (5, 6, 4) OR V.ALL = (6, 5, 4) THEN 192 NULL; 193 ELSE 194 FAILED ( S & " HAS AN INCORRECT COMPONENT " & 195 "VALUE" ); 196 END IF; 197 END CHECK6; 198 199 END PKG1; 200 201 PACKAGE PKG2 IS END PKG2; 202 203 PACKAGE BODY PKG2 IS 204 USE PKG1; 205 206 B1, B2 : PBOOL := INIT1 (1); 207 CB1, CB2 : CONSTANT PBOOL := INIT1 (2); 208 209 I1, I2 : PINT := INIT2 (3); 210 CI1, CI2 : CONSTANT PINT := INIT2 (4); 211 212 R1, R2 : PREC (G (5)) := INIT3 (5); 213 CR1, CR2 : CONSTANT PREC (G (6)) := INIT3 (6); 214 215 A1, A2 : PARR := INIT4 (7); 216 CA1, CA2 : CONSTANT PARR := INIT4 (8); 217 218 V1, V2 : PACC := INIT5 (9); 219 CV1, CV2 : CONSTANT PACC := INIT5 (10); 220 221 BEGIN 222 CHECK1 (B1, 0, "B1"); 223 CHECK1 (B2, 1, "B2"); 224 CHECK1 (CB1, 0, "CB1"); 225 CHECK1 (CB2, 1, "CB2"); 226 227 CHECK2 (I1, 1, "I1"); 228 CHECK2 (I2, 2, "I2"); 229 CHECK2 (CI1, 1, "CI1"); 230 CHECK2 (CI2, 2, "CI2"); 231 232 CHECK3 (R1, 1, 2, "R1"); 233 CHECK3 (R2, 3, 4, "R2"); 234 CHECK3 (CR1, 1, 2, "CR1"); 235 CHECK3 (CR2, 3, 4, "CR2"); 236 237 CHECK4 (A1, 1, 2, "A1"); 238 CHECK4 (A2, 3, 4, "A2"); 239 CHECK4 (CA1, 1, 2, "CA1"); 240 CHECK4 (CA2, 3, 4, "CA2"); 241 242 CHECK5 (V1, "V1"); 243 CHECK6 (V2, "V2"); 244 CHECK5 (CV1, "CV1"); 245 CHECK6 (CV2, "CV2"); 246 END PKG2; 247 248 BEGIN 249 NULL; 250 END; 251 252 RESULT; 253END C32001E; 254