1-- CD2B11A.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-- OBJECTIVE: 26-- CHECK THAT IF A COLLECTION SIZE SPECIFICATION CAN BE GIVEN FOR AN 27-- ACCESS TYPE, THEN OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT 28-- AFFECTED. 29 30-- HISTORY: 31-- BCB 11/01/88 CREATED ORIGINAL TEST. 32-- RJW 05/17/89 CHANGED FROM '.DEP' TEST TO '.ADA' TEST. 33-- ADDED CHECK FOR UNCHECKED_DEALLOCATION. 34 35WITH REPORT; USE REPORT; 36WITH SYSTEM; 37WITH UNCHECKED_DEALLOCATION; 38PROCEDURE CD2B11A IS 39 40 BASIC_SIZE : CONSTANT := 1024; 41 42 TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER; 43 TYPE ACC_TYPE IS ACCESS MAINTYPE; 44 SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3); 45 46 FOR ACC_TYPE'STORAGE_SIZE USE BASIC_SIZE; 47 48 TYPE RECORD_TYPE IS RECORD 49 COMP : ACC_TYPE; 50 END RECORD; 51 52 CHECK_TYPE1 : ACC_TYPE; 53 CHECK_TYPE2 : ACC_TYPE; 54 CHECK_TYPE3 : ACC_TYPE(1..3); 55 56 CHECK_ARRAY : ARRAY (1..2) OF ACC_TYPE; 57 58 CHECK_RECORD1 : RECORD_TYPE; 59 CHECK_RECORD2 : RECORD_TYPE; 60 61 CHECK_PARAM1 : ACC_TYPE; 62 CHECK_PARAM2 : ACC_TYPE; 63 64 CHECK_NULL : ACC_TYPE := NULL; 65 66 PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS 67 68 BEGIN 69 70 IF (ACC1.ALL /= ACC2.ALL) THEN 71 FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS " & 72 "- 1"); 73 END IF; 74 75 IF EQUAL (3,3) THEN 76 ACC2 := ACC1; 77 END IF; 78 79 IF ACC2 /= ACC1 THEN 80 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " & 81 "-1"); 82 END IF; 83 84 IF (ACC1 IN ACC_RANGE) THEN 85 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 1"); 86 END IF; 87 88 END PROC; 89 90BEGIN 91 92 TEST ("CD2B11A", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " & 93 "CAN BE GIVEN FOR AN ACCESS TYPE, THEN " & 94 "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " & 95 "NOT AFFECTED"); 96 97 CHECK_PARAM1 := NEW MAINTYPE'(25,35,45); 98 CHECK_PARAM2 := NEW MAINTYPE'(25,35,45); 99 100 PROC (CHECK_PARAM1,CHECK_PARAM2); 101 102 IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN 103 FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE"); 104 END IF; 105 106 CHECK_TYPE1 := NEW MAINTYPE'(25,35,45); 107 CHECK_TYPE2 := NEW MAINTYPE'(25,35,45); 108 CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3); 109 110 CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45); 111 CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45); 112 113 CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45); 114 CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45); 115 116 IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN 117 FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2"); 118 END IF; 119 120 IF EQUAL (3,3) THEN 121 CHECK_TYPE2 := CHECK_TYPE1; 122 END IF; 123 124 IF CHECK_TYPE2 /= CHECK_TYPE1 THEN 125 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2"); 126 END IF; 127 128 IF (CHECK_TYPE1 IN ACC_RANGE) THEN 129 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2"); 130 END IF; 131 132 IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN 133 FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3"); 134 END IF; 135 136 IF EQUAL (3,3) THEN 137 CHECK_ARRAY (2) := CHECK_ARRAY (1); 138 END IF; 139 140 IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN 141 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3"); 142 END IF; 143 144 IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN 145 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3"); 146 END IF; 147 148 IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN 149 FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4"); 150 END IF; 151 152 IF EQUAL (3,3) THEN 153 CHECK_RECORD2 := CHECK_RECORD1; 154 END IF; 155 156 IF CHECK_RECORD2 /= CHECK_RECORD1 THEN 157 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4"); 158 END IF; 159 160 IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN 161 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4"); 162 END IF; 163 164 IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN 165 FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST"); 166 END IF; 167 168 IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN 169 FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST"); 170 END IF; 171 172 DECLARE 173 TYPE ACC_CHAR IS ACCESS CHARACTER; 174 FOR ACC_CHAR'STORAGE_SIZE USE 128; 175 176 LIMIT : INTEGER := 177 (ACC_CHAR'STORAGE_SIZE * SYSTEM.STORAGE_UNIT)/CHARACTER'SIZE; 178 179 ACC_ARRAY : ARRAY (1 .. LIMIT + 1) OF ACC_CHAR; 180 PLACE : INTEGER; 181 182 PROCEDURE FREE IS 183 NEW UNCHECKED_DEALLOCATION (CHARACTER, ACC_CHAR); 184 BEGIN 185 FOR I IN ACC_ARRAY'RANGE LOOP 186 ACC_ARRAY (IDENT_INT (I)) := 187 NEW CHARACTER' 188 (IDENT_CHAR ((CHARACTER'VAL (I MOD 128)))); 189 PLACE := I; 190 END LOOP; 191 FAILED ("NO EXCEPTION RAISED WHEN COLLECTION SIZE EXCEEDED"); 192 EXCEPTION 193 WHEN STORAGE_ERROR => 194 BEGIN 195 FOR I IN 1 .. PLACE LOOP 196 IF I MOD 2 = 0 THEN 197 FREE (ACC_ARRAY (IDENT_INT (I))); 198 END IF; 199 END LOOP; 200 201 FOR I IN 1 .. PLACE LOOP 202 IF I MOD 2 = 1 AND THEN 203 IDENT_CHAR (ACC_ARRAY (I).ALL) /= 204 CHARACTER'VAL (I MOD IDENT_INT (128)) THEN 205 FAILED ("INCORRECT VALUE IN ARRAY"); 206 END IF; 207 END LOOP; 208 END; 209 WHEN OTHERS => 210 FAILED ("WRONG EXCEPTION RAISED"); 211 END; 212 213 RESULT; 214END CD2B11A; 215