1-- C52103X.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS. 26-- MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING 27-- LENGTHS DO NOT CAUSE CONSTRAINT_ERROR TO BE RAISED AND 28-- ARE PERFORMED CORRECTLY. 29-- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT 30-- ARE TREATED ELSEWHERE.) 31 32-- THIS IS A SPECIAL CASE IN 33 34-- DIVISION C : NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE 35-- STATICALLY 36 37-- WHICH TREATS ARRAYS OF LENGTH GREATER THAN INTEGER'LAST . 38-- AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH 39-- COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE 40-- CONSTRAINT_ERROR TO BE RAISED. 41 42-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X 43-- *** remove incompatibilities associated with the transition -- 9X 44-- *** to Ada 9X. -- 9X 45-- *** -- 9X 46 47-- RM 07/31/81 48-- SPS 10/26/82 49-- JBG 06/15/83 50-- EG 11/02/84 51-- EG 10/28/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO 52-- AI-00387. 53-- JRK 06/24/86 FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR. 54-- MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY 55 56WITH REPORT; 57PROCEDURE C52103X IS 58 59 USE REPORT ; 60 61BEGIN 62 63 TEST( "C52103X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " & 64 "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " & 65 "CHECK WHETHER CONSTRAINT_ERROR " & 66 "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS" ); 67 68 -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN 69 -- THE AGGREGATES ARE STRING LITERALS); THEREFORE: 70 -- 71 -- (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS; 72 -- (2) CAN'T USE NON-NULL CONSTANT ARRAYS. 73 74 75 -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION 76 -- AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL 77 -- ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS 78 -- OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON 79 -- COMPONENT_TYPE. ACCORDINGLY WE ARE TESTING FOR SOME BUT 80 -- NOT ALL KINDS OF COMPONENT_TYPE. (COMPONENT_TYPES INCLUDED: 81 -- INTEGER , CHARACTER , BOOLEAN .) 82 83 84 ------------------------------------------------------------------- 85 86 -- (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 87 -- WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL 88 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 89 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.) 90 91CONSTR_ERR: -- THIS BLOCK CATCHES CONSTRAINT_ERROR 92 -- FOR THE TYPE DECLARATION. 93 BEGIN 94 95DCL_ARR: DECLARE -- THIS BLOCK DECLARES THE ARRAY TYPE 96 97 TYPE TA42 IS ARRAY( 98 INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST) 99 ) OF BOOLEAN ; 100 -- CONSTRAINT_ERROR MAY BE RAISED BY THE 101 -- ARRAY TYPE DECLARATION. 102 PRAGMA PACK (TA42); 103 104 SUBTYPE TA41 IS TA42 ; 105 106 BEGIN 107 108 COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " & 109 "WITH 'LENGTH = INTEGER'LAST + 3"); 110 111OBJ_DCL: DECLARE -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT 112 -- HAVE INTEGER'LAST + 3 COMPONENTS; 113 -- STORAGE_ERROR MAY BE RAISED. 114 ARR41 : TA41 ; 115 ARR42 : TA42 ; 116 117 BEGIN 118 119 COMMENT ("NO STORAGE_ERROR OR CONSTRAINT_ERROR RAISED " & 120 "WHEN ALLOCATING TWO BIG BOOLEAN ARRAYS"); 121 -- INITIALIZATION OF RHS ARRAY: 122 123 -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED, 124 -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG 125 -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH 126 -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED. 127 128NO_EXCP: BEGIN -- NO EXCEPTION SHOULD OCCUR HERE. 129 FOR I IN IDENT_INT(-2)..IDENT_INT(2) LOOP 130 ARR41(I) := FALSE ; -- VALUES ARE:: FTFFT 131 END LOOP; 132 133 ARR41(-1) := TRUE ; 134 135 ARR41( 2) := TRUE ; -- RHS IS: F T F F T 136 137 138 -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY: 139 140 ARR42( -2 ) := TRUE ; 141 142 EXCEPTION 143 144 WHEN CONSTRAINT_ERROR => 145 FAILED ("CONSTRAINT_ERROR RAISED WHEN " & 146 "ASSIGNING TO ARRAY COMPONENTS"); 147 WHEN OTHERS => 148 FAILED ("OTHER EXCEPTION RAISED - 1"); 149 150 END NO_EXCP; 151 152DO_SLICE: BEGIN 153 -- SLICE ASSIGNMENT: 154 155 ARR42( IDENT_INT(-1)..IDENT_INT(INTEGER'LAST )) := 156 ARR41( 157 IDENT_INT(-2)..IDENT_INT(INTEGER'LAST-1)) ; 158 159 COMMENT ("NO EXCEPTION RAISED DURING SLICE " & 160 "ASSIGNMENT"); 161 162 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT: 163 164 CHK_SLICE: BEGIN 165 FOR I IN IDENT_INT(-1)..IDENT_INT(2) LOOP 166 167 IF ARR42( I ) /= FALSE AND I /= 0 168 THEN 169 FAILED( "SLICE ASSIGNMENT NOT " & 170 "CORRECT (VALUES)" ); 171 ELSIF ARR42( I ) /= TRUE AND I = 0 172 THEN 173 FAILED( "SLICE ASSIGNMENT NOT " & 174 "CORRECT (VALUES)" ); 175 END IF; 176 177 END LOOP; 178 179 IF ARR42( -2 ) /= TRUE 180 THEN 181 FAILED( "SLICE ASSIGNMENT NOT CORRECT " & 182 "(SLIDING)" ); 183 END IF; 184 185 EXCEPTION 186 187 WHEN OTHERS => 188 FAILED ("SOME EXCEPTION RAISED - 2"); 189 190 END CHK_SLICE; 191 192 EXCEPTION 193 194 WHEN CONSTRAINT_ERROR => 195 COMMENT ("CONSTRAINT_ERROR RAISED DURING " & 196 "SLICE ASSIGNMENT"); 197 WHEN STORAGE_ERROR => 198 COMMENT ("STORAGE_ERROR RAISED DURING SLICE " & 199 "ASSIGNMENT"); 200 WHEN OTHERS => 201 FAILED ("SOME EXCEPTION DURING SLICE " & 202 "ASSIGNMENT"); 203 END DO_SLICE; 204 205 END OBJ_DCL; 206 207 EXCEPTION 208 209 WHEN STORAGE_ERROR => 210 COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " & 211 "TWO PACKED BOOLEAN ARRAYS WITH " & 212 "INTEGER'LAST + 3 COMPONENTS"); 213 WHEN CONSTRAINT_ERROR => 214 COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " & 215 "TWO PACKED BOOLEAN ARRAYS WITH " & 216 "INTEGER'LAST + 3 COMPONENTS"); 217 WHEN OTHERS => 218 FAILED ("SOME EXCEPTION RAISED - 3"); 219 220 END DCL_ARR; 221 222 EXCEPTION 223 224 225 WHEN CONSTRAINT_ERROR => 226 COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " & 227 "ARRAY TYPE WITH INTEGER'LAST + 3 COMPONENTS"); 228 229 WHEN STORAGE_ERROR => 230 FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION"); 231 232 WHEN OTHERS => 233 FAILED ("OTHER EXCEPTION RAISED - 4"); 234 235 END CONSTR_ERR; 236 237 238 RESULT ; 239 240 241END C52103X; 242