1-- CC1220A.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-- OBJECTIVE: 26-- CHECK THAT A GENERIC UNIT CAN REFER TO AN IMPLICITLY 27-- DECLARED PREDEFINED OPERATOR. 28 29-- HISTORY: 30-- DAT 08/20/81 CREATED ORIGINAL TEST. 31-- SPS 05/03/82 32-- BCB 08/04/88 MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER 33-- OPERATIONS OF A DISCRETE TYPE. 34-- RJW 03/27/90 REVISED TEST TO CHECK FOR A GENERIC FORMAL 35-- DISCRETE TYPE. 36-- CJJ 10/14/90 ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=); 37-- MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC. 38 39WITH REPORT; USE REPORT; 40WITH SYSTEM; USE SYSTEM; 41 42PROCEDURE CC1220A IS 43 44BEGIN 45 TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " & 46 "DECLARED OPERATORS"); 47 48 49 DECLARE 50 51 GENERIC 52 TYPE T IS (<>); 53 STR : STRING; 54 P1 : T := T'FIRST; 55 P2 : T := T(T'SUCC (P1)); 56 P3 : T := T'(T'PRED (P2)); 57 P4 : INTEGER := IDENT_INT(T'WIDTH); 58 P5 : BOOLEAN := (P1 < P2) AND (P2 > P3); 59 P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1); 60 P7 : BOOLEAN := (P3 = P1); 61 P8 : T := T'BASE'FIRST; 62 P10 : T := T'LAST; 63 P11 : INTEGER := T'SIZE; 64 P12 : ADDRESS := P10'ADDRESS; 65 P13 : INTEGER := T'WIDTH; 66 P14 : INTEGER := T'POS(T'LAST); 67 P15 : T := T'VAL(1); 68 P16 : INTEGER := T'POS(P15); 69 P17 : STRING := T'IMAGE(T'BASE'LAST); 70 P18 : T := T'VALUE(P17); 71 P19 : BOOLEAN := (P15 IN T); 72 WITH FUNCTION IDENT (X : T) RETURN T; 73 PACKAGE PKG IS 74 ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3); 75 B1 : BOOLEAN := P7 AND P19; 76 B2 : BOOLEAN := P5 AND P6; 77 END PKG; 78 79 PACKAGE BODY PKG IS 80 BEGIN 81 IF P1 /= T(T'FIRST) THEN 82 FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR); 83 END IF; 84 85 IF T'SUCC (P1) /= IDENT (P2) OR 86 T'PRED (P2) /= IDENT (P1) THEN 87 FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR); 88 END IF; 89 90 IF P10 /= T(T'LAST) THEN 91 FAILED ("IMPROPER VALUE FOR 'LAST - " & STR); 92 END IF; 93 94 IF NOT EQUAL(P11,T'SIZE) THEN 95 FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR); 96 END IF; 97 98 IF NOT EQUAL(P13,T'WIDTH) THEN 99 FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR); 100 END IF; 101 102 IF NOT EQUAL (P16, T'POS (P15)) OR 103 T'VAL (P16) /= T(IDENT (P15)) THEN 104 FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR); 105 END IF; 106 107 IF T'VALUE (P17) /= T'BASE'LAST OR 108 T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN 109 FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " & 110 STR); 111 END IF; 112 END PKG; 113 114 BEGIN 115 DECLARE 116 TYPE CHAR IS ('A', 'B', 'C', 'D', 'E'); 117 118 FUNCTION IDENT (C : CHAR) RETURN CHAR IS 119 BEGIN 120 RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C))); 121 END IDENT; 122 123 PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR", 124 IDENT => IDENT); 125 BEGIN 126 IF N_CHAR.ARR (1) /= IDENT ('A') OR 127 N_CHAR.ARR (2) /= IDENT ('B') OR 128 N_CHAR.ARR (3) /= 'A' OR 129 N_CHAR.B1 /= TRUE OR 130 N_CHAR.B2 /= TRUE THEN 131 FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" & 132 " IN INSTANTIATION OF N_CHAR."); 133 END IF; 134 END; 135 136 DECLARE 137 TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC); 138 139 FUNCTION IDENT (C : ENUM) RETURN ENUM IS 140 BEGIN 141 RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C))); 142 END IDENT; 143 144 PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM", 145 IDENT => IDENT); 146 147 BEGIN 148 IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR 149 N_ENUM.ARR (2) /= IDENT (ADA) OR 150 N_ENUM.ARR (3) /= JOVIAL OR 151 N_ENUM.B1 /= TRUE OR 152 N_ENUM.B2 /= TRUE THEN 153 FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" & 154 " IN INSTANTIATION OF N_ENUM."); 155 END IF; 156 END; 157 158 DECLARE 159 160 PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER", 161 IDENT => IDENT_INT); 162 BEGIN 163 IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR 164 N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR 165 N_INT.ARR (3) /= INTEGER'FIRST OR 166 N_INT.B1 /= TRUE OR 167 N_INT.B2 /= TRUE THEN 168 FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" & 169 " IN INSTANTIATION OF N_INT."); 170 END IF; 171 END; 172 END; 173 RESULT; 174END CC1220A; 175