1-- C47002C.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 26-- THE OPERANDS OF QUALIFIED EXPRESSIONS. 27-- THIS TEST IS FOR ARRAY, RECORD, AND ACCESS TYPES. 28 29-- RJW 7/23/86 30 31WITH REPORT; USE REPORT; 32PROCEDURE C47002C IS 33 34BEGIN 35 36 TEST( "C47002C", "CHECK THAT VALUES HAVING ARRAY, RECORD, AND " & 37 "ACCESS TYPES CAN BE WRITTEN AS THE OPERANDS " & 38 "OF QUALIFIED EXPRESSIONS" ); 39 40 DECLARE -- ARRAY TYPES. 41 42 TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER; 43 SUBTYPE ARR1 IS ARR (1 .. 1); 44 SUBTYPE ARR5 IS ARR (1 .. 5); 45 46 TYPE NARR IS NEW ARR; 47 SUBTYPE NARR2 IS NARR (2 .. 2); 48 49 TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 50 OF INTEGER; 51 SUBTYPE TARR15 IS TARR (1 .. 1, 1 .. 5); 52 SUBTYPE TARR51 IS TARR (1 .. 5, 1 .. 1); 53 54 TYPE NTARR IS NEW TARR; 55 SUBTYPE NTARR26 IS NTARR (2 .. 6, 2 .. 6); 56 57 FUNCTION F (X : ARR) RETURN ARR IS 58 BEGIN 59 RETURN X; 60 END; 61 62 FUNCTION F (X : NARR) RETURN NARR IS 63 BEGIN 64 RETURN X; 65 END; 66 67 FUNCTION F (X : TARR) RETURN TARR IS 68 BEGIN 69 RETURN X; 70 END; 71 72 FUNCTION F (X : NTARR) RETURN NTARR IS 73 BEGIN 74 RETURN X; 75 END; 76 77 BEGIN 78 IF F (ARR1'(OTHERS => 0))'LAST /= 1 THEN 79 FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR1" ); 80 END IF; 81 82 IF F (ARR5'(OTHERS => 0))'LAST /= 5 THEN 83 FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR5" ); 84 END IF; 85 86 IF F (NARR2'(OTHERS => 0))'FIRST /= 2 OR 87 F (NARR2'(OTHERS => 0))'LAST /= 2 THEN 88 FAILED ( "INCORRECT RESULTS FOR SUBTYPE NARR2" ); 89 END IF; 90 91 IF F (TARR15'(OTHERS => (OTHERS => 0)))'LAST /= 1 OR 92 F (TARR15'(OTHERS => (OTHERS => 0)))'LAST (2) /= 5 THEN 93 FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR15" ); 94 END IF; 95 96 IF F (TARR51'(OTHERS => (OTHERS => 0)))'LAST /= 5 OR 97 F (TARR51'(OTHERS => (OTHERS => 0)))'LAST (2) /= 1 THEN 98 FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR51" ); 99 END IF; 100 101 IF F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST /= 2 OR 102 F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST /= 6 OR 103 F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST (2) /= 2 OR 104 F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST (2) /= 6 THEN 105 FAILED ( "INCORRECT RESULTS FOR SUBTYPE NTARR26" ); 106 END IF; 107 108 END; 109 110 DECLARE -- RECORD TYPES. 111 112 TYPE GENDER IS (MALE, FEMALE, NEUTER); 113 114 TYPE MAN IS 115 RECORD 116 AGE : POSITIVE; 117 END RECORD; 118 119 TYPE WOMAN IS 120 RECORD 121 AGE : POSITIVE; 122 END RECORD; 123 124 TYPE ANDROID IS NEW MAN; 125 126 FUNCTION F (X: WOMAN) RETURN GENDER IS 127 BEGIN 128 RETURN FEMALE; 129 END F; 130 131 FUNCTION F (X: MAN) RETURN GENDER IS 132 BEGIN 133 RETURN MALE; 134 END F; 135 136 FUNCTION F (X : ANDROID) RETURN GENDER IS 137 BEGIN 138 RETURN NEUTER; 139 END F; 140 141 BEGIN 142 IF F (MAN'(AGE => 23)) /= MALE THEN 143 FAILED ( "INCORRECT RESULTS FOR SUBTYPE MAN" ); 144 END IF; 145 146 IF F (WOMAN'(AGE => 38)) /= FEMALE THEN 147 FAILED ( "INCORRECT RESULTS FOR SUBTYPE WOMAN" ); 148 END IF; 149 150 IF F (ANDROID'(AGE => 2001)) /= NEUTER THEN 151 FAILED ( "INCORRECT RESULTS FOR TYPE ANDRIOD" ); 152 END IF; 153 END; 154 155 DECLARE -- ACCESS TYPES. 156 157 TYPE CODE IS (OLD, BRANDNEW, WRECK); 158 159 TYPE CAR (D : CODE) IS 160 RECORD 161 NULL; 162 END RECORD; 163 164 TYPE KEY IS ACCESS CAR; 165 166 TYPE KEY_OLD IS ACCESS CAR (OLD); 167 KO : KEY_OLD := NEW CAR'(D => OLD); 168 169 TYPE KEY_WRECK IS ACCESS CAR (WRECK); 170 171 TYPE KEY_CARD IS NEW KEY; 172 KC : KEY_CARD := NEW CAR'(D => BRANDNEW); 173 174 FUNCTION F (X : KEY_OLD) RETURN CODE IS 175 BEGIN 176 RETURN OLD; 177 END F; 178 179 FUNCTION F (X : KEY_WRECK) RETURN CODE IS 180 BEGIN 181 RETURN WRECK; 182 END F; 183 184 FUNCTION F (X : KEY_CARD) RETURN CODE IS 185 BEGIN 186 RETURN BRANDNEW; 187 END F; 188 BEGIN 189 IF KEY_OLD'(KO) /= KO THEN 190 FAILED ( "INCORRECT RESULTS FOR TYPE KEY_OLD - 1" ); 191 END IF; 192 193 IF KEY_CARD'(KC) /= KC THEN 194 FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 1" ); 195 END IF; 196 197 198 IF F (KEY_OLD'(NULL)) /= OLD THEN 199 FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_OLD - 2" ); 200 END IF; 201 202 IF F (KEY_WRECK'(NULL)) /= WRECK THEN 203 FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_WRECK" ); 204 END IF; 205 206 IF F (KEY_CARD'(NULL)) /= BRANDNEW THEN 207 FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 2" ); 208 END IF; 209 END; 210 211 RESULT; 212END C47002C; 213