1-- C52011A.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 INDEX CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES. 26-- SPECIFICALLY, CHECK THAT: 27 28-- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT 29-- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED 30-- IS NULL. 31 32-- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED 33-- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE. 34 35-- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS 36-- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES. 37 38-- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT 39-- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS 40-- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER 41-- FROM THOSE ON THE SUBTYPE. 42 43-- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED 44-- SUBTYPES OF THIS TYPE. 45 46-- ASL 6/29/81 47-- RM 6/17/82 48-- SPS 10/26/82 49-- RLB 6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION. 50 51WITH REPORT; 52PROCEDURE C52011A IS 53 54 USE REPORT; 55 56 TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER; 57 TYPE ARR_NAME IS ACCESS ARR; 58 SUBTYPE S1 IS ARR_NAME(IDENT_INT(1)..IDENT_INT(10)); 59 SUBTYPE S2 IS ARR_NAME(IDENT_INT(3)..IDENT_INT(6)); 60 61 W : ARR_NAME := NULL; -- E. 62 X1,X2 : S1 := NULL; -- E. 63 Y1,Y2 : S2 := NULL; -- E. 64 65 W_NONNULL : ARR_NAME := NEW ARR'(3..5=>7) ; 66 X1_NONNULL : S1 := NEW ARR'(IDENT_INT(1)..IDENT_INT(10)=>7); 67 Y1_NONNULL : S2 := NEW ARR'(IDENT_INT(3)..IDENT_INT( 6)=>7); 68 69 TOO_EARLY : BOOLEAN := TRUE; 70 71BEGIN 72 73 TEST ("C52011A", "INDEX CONSTRAINTS ON ACCESS SUBTYPE OBJECTS " & 74 "MUST BE SATISFIED FOR ASSIGNMENT"); 75 76 BEGIN 77 78 IF EQUAL(3,3) THEN 79 W_NONNULL := X1; -- A. 80 END IF; 81 IF W_NONNULL /= X1 THEN 82 FAILED ("ASSIGNMENT FAILED - 1"); 83 END IF; 84 85 IF EQUAL(3,3) THEN 86 X1_NONNULL := X2; -- A. 87 END IF; 88 IF X1_NONNULL /= X2 THEN 89 FAILED ("ASSIGNMENT FAILED - 2"); 90 END IF; 91 92 IF EQUAL(3,3) THEN 93 X1_NONNULL := Y1; -- A. 94 END IF; 95 IF X1 /= Y1 THEN 96 FAILED ("ASSIGNMENT FAILED - 3"); 97 END IF; 98 99 X1 := NEW ARR'(1..IDENT_INT(10) => 5); 100 IF EQUAL(3,3) THEN 101 X2 := X1; -- B. 102 END IF; 103 IF X2 /= X1 THEN 104 FAILED ("ASSIGNMENT FAILED - 4"); 105 END IF; 106 107 IF EQUAL(3,3) THEN 108 W := X1; -- B. 109 END IF; 110 IF W /= X1 THEN 111 FAILED ("ASSIGNMENT FAILED - 5"); 112 END IF; 113 114 BEGIN 115 Y1 := X1; -- C. 116 IF Y1'FIRST /= REPORT.IDENT_INT(3) THEN 117 FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " & 118 "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " & 119 "AND CONSTRAINT IS CHANGED"); 120 ELSE 121 FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " & 122 "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " & 123 "AND CONSTRAINT IS NOT CHANGED"); 124 END IF; 125 EXCEPTION 126 127 WHEN CONSTRAINT_ERROR => NULL; 128 129 WHEN OTHERS => 130 FAILED ("WRONG EXCEPTION - 1"); 131 132 END; 133 134 W := NEW ARR'(IDENT_INT(3)..IDENT_INT(6) => 3); 135 136 BEGIN 137 X1 := W; -- D. 138 IF X1'FIRST /= REPORT.IDENT_INT(1) THEN 139 FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " & 140 "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "& 141 "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " & 142 "AND CONSTRAINT IS CHANGED"); 143 ELSE 144 FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " & 145 "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "& 146 "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " & 147 "AND CONSTRAINT IS NOT CHANGED"); 148 END IF; 149 EXCEPTION 150 151 WHEN CONSTRAINT_ERROR => 152 NULL ; 153 154 WHEN OTHERS => 155 FAILED ("WRONG EXCEPTION - 2"); 156 157 END; 158 159 EXCEPTION 160 161 WHEN OTHERS => 162 FAILED ("EXCEPTION RAISED"); 163 164 END; 165 166 167 RESULT; 168 169 170END C52011A; 171