1-- C37003A.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 MULTIPLE COMPONENT DECLARATIONS ARE TREATED AS A SERIES 26-- OF SINGLE COMNENT DECLARATIONS, I.E., THE COMPONENTS ALL HAVE THE 27-- SAME TYPE AND ANY EXPRESSION USED IN CONSTRAINTS OR INITIALIZATIONS 28-- IS EVALUATED ONCE FOR EACH COMPONENT. 29 30-- DAT 3/30/81 31-- SPS 10/26/82 32-- JWC 10/23/85 RENAMED FROM C37013A-AB.ADA. 33-- ADDED TEST TO ENSURE THAT ANY EXPRESSION USED 34-- IN A CONSTRAINT IS EVALUATED ONCE FOR EACH 35-- COMPONENT. 36-- JRK 11/15/85 ADDED INITIALIZATION EVALUATION CHECKS. 37 38WITH REPORT; USE REPORT; 39 40PROCEDURE C37003A IS 41 42 X : INTEGER := 0; 43 44 FUNCTION F RETURN INTEGER IS 45 BEGIN 46 X := X + 1; 47 RETURN X; 48 END F; 49 50 PROCEDURE RESET IS 51 BEGIN 52 X := 0; 53 END RESET; 54 55BEGIN 56 TEST ("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " & 57 "ARE TREATED AS A SERIES OF SINGLE COMPONENT " & 58 "DECLARATIONS"); 59 60 DECLARE 61 62 TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER; 63 64 TYPE REC1 IS RECORD 65 A1, A2 : ARR (1 .. F) := (OTHERS => F); 66 END RECORD; 67 68 R1 : REC1 := (OTHERS => (OTHERS => 1)); 69 Y : INTEGER := X; 70 R1A : REC1; 71 72 BEGIN 73 74 IF R1.A1 = R1.A2 THEN -- TEST TO SEE IF THE COMPONENTS 75 NULL; -- ARE OF THE SAME TYPE. 76 END IF; 77 78 IF Y /= 2 THEN 79 FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " & 80 "FOR ARRAYS"); 81 END IF; 82 83 IF X /= 5 THEN 84 FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " & 85 "EACH ARRAY COMPONENT"); 86 END IF; 87 88 RESET; 89 90 END; 91 92 DECLARE 93 94 TYPE REC2 IS RECORD 95 I1, I2 : INTEGER RANGE 1 .. F := F * IDENT_INT(0) + 1; 96 END RECORD; 97 98 R2 : REC2 := (OTHERS => 1); 99 Y : INTEGER := X; 100 R2A : REC2; 101 102 BEGIN 103 104 IF R2.I1 = R2.I2 THEN -- TEST TO SEE IF THE COMPONENTS 105 NULL; -- ARE OF THE SAME TYPE. 106 END IF; 107 108 IF Y /= 2 THEN 109 FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " & 110 "FOR SCALARS"); 111 END IF; 112 113 IF X /= 4 THEN 114 FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " & 115 "EACH SCALAR COMPONENT"); 116 END IF; 117 118 RESET; 119 120 END; 121 122 DECLARE 123 124 TYPE REC3X (DSC : INTEGER) IS RECORD 125 NULL; 126 END RECORD; 127 128 TYPE REC3Y IS RECORD 129 I : INTEGER; 130 END RECORD; 131 132 TYPE REC3 IS RECORD 133 RX1, RX2 : REC3X (F); 134 RY1, RY2 : REC3Y := (I => F); 135 END RECORD; 136 137 R3 : REC3 := ((DSC => 1), (DSC => 2), (I => 0), (I => 0)); 138 Y : INTEGER := X; 139 R3A : REC3; 140 141 BEGIN 142 143 IF R3.RX1 = R3.RX2 THEN -- TEST TO SEE IF THE COMPONENTS 144 NULL; -- ARE OF THE SAME TYPE. 145 END IF; 146 147 IF Y /= 2 THEN 148 FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " & 149 "FOR RECORDS"); 150 END IF; 151 152 IF X /= 4 THEN 153 FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " & 154 "FOR EACH RECORD COMPONENT"); 155 END IF; 156 157 RESET; 158 159 END; 160 161 DECLARE 162 163 TYPE REC4X (DSC : INTEGER) IS RECORD 164 NULL; 165 END RECORD; 166 167 TYPE ACR IS ACCESS REC4X; 168 TYPE ACI IS ACCESS INTEGER; 169 170 TYPE REC4 IS RECORD 171 AC1, AC2 : ACR (F); 172 AC3, AC4 : ACI := NEW INTEGER'(F); 173 END RECORD; 174 175 R4 : REC4 := (NULL, NULL, NULL, NULL); 176 Y : INTEGER := X; 177 R4A : REC4; 178 179 BEGIN 180 181 IF R4.AC1 = R4.AC2 THEN -- TEST TO SEE IF THE COMPONENTS 182 NULL; -- ARE OF THE SAME TYPE. 183 END IF; 184 185 IF Y /= 2 THEN 186 FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " & 187 "FOR ACCESS"); 188 END IF; 189 190 IF X /= 4 THEN 191 FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " & 192 "FOR EACH ACCESS COMPONENT"); 193 END IF; 194 195 END; 196 197 RESULT; 198END C37003A; 199