1-- C52104Y.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 ATTEMPTED ASSIGNMENTS BETWEEN 27-- ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY 28-- INTACT AND CAUSE CONSTRAINT_ERROR TO BE RAISED. 29-- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT 30-- ARE TREATED ELSEWHERE.) 31 32-- THIS IS A SPECIAL CASE IN 33 34-- DIVISION D : NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE 35-- STATICALLY 36 37-- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH 38-- ALONG ONE DIMENSION IS GREATER THAN INTEGER'LAST AND WHOSE 39-- LENGTH ALONG THE OTHER DIMENSION IS 0 . 40-- AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH 41-- COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE CONSTRAINT_ERROR 42-- TO BE RAISED. 43 44-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X 45-- *** remove incompatibilities associated with the transition -- 9X 46-- *** to Ada 9X. -- 9X 47-- *** -- 9X 48 49-- RM 07/31/81 50-- SPS 03/22/83 51-- JBG 06/16/83 52-- EG 10/28/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO 53-- AI-00387. 54-- MRM 03/30/93 REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY 55 56WITH REPORT; 57PROCEDURE C52104Y IS 58 59 USE REPORT ; 60 61BEGIN 62 63 TEST( "C52104Y" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" & 64 " ASSIGNMENTS, THE LENGTHS MUST MATCH" ); 65 66 -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN 67 -- THE AGGREGATES ARE STRING LITERALS); THEREFORE: 68 -- 69 -- (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS; 70 -- (2) CAN'T USE NON-NULL CONSTANT ARRAYS. 71 72 73 -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION 74 -- AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL 75 -- ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS 76 -- OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON 77 -- COMPONENT_TYPE. ACCORDINGLY WE ARE TESTING FOR SOME BUT 78 -- NOT ALL KINDS OF COMPONENT_TYPE. (COMPONENT_TYPES INCLUDED: 79 -- INTEGER , CHARACTER , BOOLEAN .) 80 81 82 ------------------------------------------------------------------- 83 84 -- (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE 85 -- DEFINED USING THE "BOX" COMPOUND SYMBOL. 86 -- (TWO-DIMENSIONAL ARRAYS OF BOOLEANS.) 87 88CONSTR_ERR: 89 BEGIN -- THIS BLOCK CATCHES CONSTRAINT_ERROR IF IT IS 90 -- RAISED BY THE SUBTYPE DECLARATION. 91 92DCL_ARR: DECLARE 93 94 TYPE TABOX5 IS ARRAY( INTEGER RANGE <> , 95 INTEGER RANGE <> ) OF BOOLEAN ; 96 PRAGMA PACK (TABOX5); 97 98 SUBTYPE TABOX52 IS TABOX5( 99 IDENT_INT(13)..IDENT_INT( 13 ) , 100 IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) ); 101 102 BEGIN 103 104 COMMENT ("NO CONSTRAINT_ERROR FOR NON-NULL ARRAY SUBTYPE " & 105 "WHEN ONE DIMENSION HAS INTEGER'LAST + 3 " & 106 "COMPONENTS"); 107 108OBJ_DCL: DECLARE -- THIS BLOCK DECLARES ONE NULL ARRAY AND ONE 109 -- PACKED BOOLEAN ARRAY WITH INTEGER'LAST + 3 110 -- COMPONENTS; STORAGE ERROR MAY BE RAISED. 111 112 ARRX51 : TABOX5( 113 IDENT_INT(13)..IDENT_INT( 12 ) , 114 IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) ); 115 ARRX52 : TABOX52 ; -- BIG ARRAY HERE. 116 117 BEGIN 118 119 COMMENT ("NO CONSTRAINT OR STORAGE ERROR WHEN ARRAY "& 120 "WITH INTEGER'LAST+3 COMPONENTS ALLOCATED"); 121 122 -- NULL ARRAY ASSIGNMENT: 123 124 ARRX52 := ARRX51 ; 125 FAILED( "EXCEPTION NOT RAISED (10)" ); 126 127 EXCEPTION 128 129 WHEN CONSTRAINT_ERROR => 130 COMMENT ("CONSTRAINT_ERROR RAISED WHEN " & 131 "CHECKING LENGTHS FOR ARRAY HAVING " & 132 "> INTEGER'LAST COMPONENTS ON ONE " & 133 "DIMENSION"); 134 135 136 WHEN OTHERS => 137 FAILED( "OTHER EXCEPTION RAISED - SUBTEST 10"); 138 139 END OBJ_DCL; 140 141 EXCEPTION 142 143 WHEN STORAGE_ERROR => 144 COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING ONE "& 145 "PACKED BOOLEAN ARRAY WITH INTEGER'LAST "& 146 "+ 3 COMPONENTS"); 147 WHEN CONSTRAINT_ERROR => 148 COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING "& 149 "ONE PACKED BOOLEAN ARRAY WITH "& 150 "INTEGER'LAST + 3 COMPONENTS"); 151 WHEN OTHERS => 152 FAILED ("SOME EXCEPTION RAISED - 3"); 153 154 END DCL_ARR; 155 156 EXCEPTION 157 158 159 WHEN CONSTRAINT_ERROR => 160 COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " & 161 "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " & 162 "COMPONENTS"); 163 164 WHEN STORAGE_ERROR => 165 FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION"); 166 167 WHEN OTHERS => 168 FAILED( "OTHER EXCEPTION RAISED - 4"); 169 170 END CONSTR_ERR; 171 172 RESULT ; 173 174END C52104Y; 175