1-- C52011B.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 DISCRIMINANT 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 7/06/81 47-- RM 6/17/82 48-- RLB 6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION. 49 50WITH REPORT; 51PROCEDURE C52011B IS 52 53 USE REPORT; 54 55 TYPE REC(DISC : INTEGER := -1 ) IS 56 RECORD 57 NULL; 58 END RECORD; 59 60 TYPE REC_NAME IS ACCESS REC; 61 SUBTYPE S1 IS REC_NAME(IDENT_INT(5)); 62 SUBTYPE S2 IS REC_NAME(IDENT_INT(3)); 63 64 W : REC_NAME := NULL; -- E. 65 X1,X2 : S1 := NULL; -- E. 66 Y1,Y2 : S2 := NULL; -- E. 67 68 W_NONNULL : REC_NAME := NEW REC(7) ; 69 X1_NONNULL : S1 := NEW REC(IDENT_INT(5)); 70 Y1_NONNULL : S2 := NEW REC(IDENT_INT(3)); 71 72 TOO_EARLY : BOOLEAN := TRUE; 73 74BEGIN 75 76 TEST ("C52011B", "DISCRIMINANT CONSTRAINTS ON ACCESS SUBTYPE " & 77 "OBJECTS MUST BE SATISFIED FOR ASSIGNMENT"); 78 79 BEGIN 80 81 IF EQUAL(3,3) THEN 82 W_NONNULL := X1; -- A. 83 END IF; 84 IF W_NONNULL /= X1 THEN 85 FAILED ("ASSIGNMENT FAILED - 1"); 86 END IF; 87 88 IF EQUAL(3,3) THEN 89 W := Y1; -- A. 90 END IF; 91 IF W /= Y1 THEN 92 FAILED ("ASSIGNMENT FAILED - 2"); 93 END IF; 94 95 IF EQUAL(3,3) THEN 96 X1_NONNULL := Y1; -- A. 97 END IF; 98 IF X1_NONNULL /= Y1 THEN 99 FAILED ("ASSIGNMENT FAILED - 3"); 100 END IF; 101 102 IF EQUAL(3,3) THEN 103 Y1_NONNULL := Y2; -- A. 104 END IF; 105 IF Y1_NONNULL /= Y2 THEN 106 FAILED ("ASSIGNMENT FAILED - 4"); 107 END IF; 108 109 X1 := NEW REC(IDENT_INT(5)); 110 IF EQUAL(3,3) THEN 111 X2 := X1; -- B. 112 END IF; 113 IF X1 /= X2 THEN 114 FAILED ("ASSIGNMENT FAILED - 5"); 115 END IF; 116 117 IF EQUAL(3,3) THEN 118 W := X1; -- B. 119 END IF; 120 IF W /= X1 THEN 121 FAILED ("ASSIGNMENT FAILED - 6"); 122 END IF; 123 124 BEGIN 125 Y1 := X1; -- C. 126 IF Y1.DISC /= REPORT.IDENT_INT(3) THEN 127 FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " & 128 "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " & 129 "AND CONSTRAINT IS CHANGED"); 130 ELSE 131 FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " & 132 "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " & 133 "AND CONSTRAINT IS NOT CHANGED"); 134 END IF; 135 EXCEPTION 136 137 WHEN CONSTRAINT_ERROR => NULL; 138 139 WHEN OTHERS => 140 FAILED ("WRONG EXCEPTION - 1"); 141 142 END; 143 144 W := NEW REC(IDENT_INT(3)); 145 146 BEGIN 147 X1 := W; -- D. 148 IF X1.DISC /= REPORT.IDENT_INT(5) THEN 149 FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " & 150 "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "& 151 "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " & 152 "AND CONSTRAINT IS CHANGED"); 153 ELSE 154 FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " & 155 "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "& 156 "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " & 157 "AND CONSTRAINT IS NOT CHANGED"); 158 END IF; 159 EXCEPTION 160 161 WHEN CONSTRAINT_ERROR => 162 NULL ; 163 164 WHEN OTHERS => 165 FAILED ("WRONG EXCEPTION - 2"); 166 167 END; 168 169 EXCEPTION 170 171 WHEN OTHERS => 172 FAILED ("EXCEPTION RAISED"); 173 174 END; 175 176 177 RESULT; 178 179 180END C52011B; 181