1-- CC3601A.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 PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL 26-- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN 27-- CC3601C). 28 29-- R.WILLIAMS 10/9/86 30-- JRL 11/15/95 Added unknown discriminant part to all formal 31-- private types. 32 33 34WITH REPORT; USE REPORT; 35PROCEDURE CC3601A IS 36 37 GENERIC 38 TYPE T (<>) IS PRIVATE; 39 V, V1 : T; 40 KIND : STRING; 41 WITH FUNCTION F1 (X : IN T) RETURN T; 42 PACKAGE GP1 IS 43 R : BOOLEAN := F1 (V) = V1; 44 END GP1; 45 46 PACKAGE BODY GP1 IS 47 BEGIN 48 IF NOT (IDENT_BOOL(R)) THEN 49 FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND); 50 END IF; 51 END GP1; 52 53 GENERIC 54 TYPE T (<>) IS PRIVATE; 55 V, V1, V2 : IN T; 56 KIND : STRING; 57 WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T; 58 PACKAGE GP2 IS 59 R : BOOLEAN := V /= F1 (V1, V2); 60 END GP2; 61 62 PACKAGE BODY GP2 IS 63 BEGIN 64 IF IDENT_BOOL (R) THEN 65 FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND); 66 END IF; 67 END GP2; 68 69 70 GENERIC 71 TYPE T1 (<>) IS PRIVATE; 72 TYPE T2 (<>) IS PRIVATE; 73 V1 : T1; 74 V2 : T2; 75 KIND : STRING; 76 WITH FUNCTION F1 (X : IN T1) RETURN T2; 77 PACKAGE GP3 IS 78 R : BOOLEAN := F1 (V1) = V2; 79 END GP3; 80 81 PACKAGE BODY GP3 IS 82 BEGIN 83 IF NOT (IDENT_BOOL(R)) THEN 84 FAILED ( "INCORRECT VALUE FOR OP - " & KIND); 85 END IF; 86 END GP3; 87 88BEGIN 89 TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " & 90 "PASSED AS ACTUAL GENERIC SUBPROGRAM " & 91 "PARAMETERS" ); 92 93 94 BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS 95 -- ACTUAL PARAMETERS. 96 97 FOR I1 IN BOOLEAN LOOP 98 99 FOR I2 IN BOOLEAN LOOP 100 COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " & 101 "B2 = " & BOOLEAN'IMAGE (I2) ); 102 DECLARE 103 B1 : BOOLEAN := IDENT_BOOL (I1); 104 B2 : BOOLEAN := IDENT_BOOL (I2); 105 106 PACKAGE P1 IS 107 NEW GP1 (BOOLEAN, NOT B2, B2, 108 """NOT"" - 1", "NOT"); 109 PACKAGE P2 IS 110 NEW GP2 (BOOLEAN, B1 OR B2, B1, B2, 111 "OR", "OR"); 112 PACKAGE P3 IS 113 NEW GP2 (BOOLEAN, B1 AND B2, B2, B1, 114 "AND", "AND"); 115 PACKAGE P4 IS 116 NEW GP2 (BOOLEAN, B1 /= B2, B1, B2, 117 "XOR", "XOR"); 118 PACKAGE P5 IS 119 NEW GP2 (BOOLEAN, B1 < B2, B1, B2, 120 "<", "<"); 121 PACKAGE P6 IS 122 NEW GP2 (BOOLEAN, B1 <= B2, B1, B2, 123 "<=", "<="); 124 PACKAGE P7 IS 125 NEW GP2 (BOOLEAN, B1 > B2, B1, B2, 126 ">", ">"); 127 PACKAGE P8 IS 128 NEW GP2 (BOOLEAN, B1 >= B2, B1, B2, 129 ">=", ">="); 130 131 TYPE AB IS ARRAY (BOOLEAN RANGE <> ) 132 OF BOOLEAN; 133 AB1 : AB (BOOLEAN) := (B1, B2); 134 AB2 : AB (BOOLEAN) := (B2, B1); 135 T : AB (B1 .. B2) := (B1 .. B2 => TRUE); 136 F : AB (B1 .. B2) := (B1 .. B2 => FALSE); 137 VB1 : AB (B1 .. B1) := (B1 => B2); 138 VB2 : AB (B2 .. B2) := (B2 => B1); 139 140 PACKAGE P9 IS 141 NEW GP1 (AB, AB1, NOT AB1, 142 """NOT"" - 2", "NOT"); 143 PACKAGE P10 IS 144 NEW GP1 (AB, T, F, 145 """NOT"" - 3", "NOT"); 146 PACKAGE P11 IS 147 NEW GP1 (AB, VB2, (B2 => NOT B1), 148 """NOT"" - 4", "NOT"); 149 PACKAGE P12 IS 150 NEW GP2 (AB, AB1 AND AB2, AB1, AB2, 151 "AND", "AND"); 152 BEGIN 153 NULL; 154 END; 155 END LOOP; 156 END LOOP; 157 END; 158 159 DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", 160 -- AND "ABS". 161 162 PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+"); 163 164 PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+"); 165 166 PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3", 167 "+"); 168 PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-"); 169 170 PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-"); 171 172 PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3", 173 "-"); 174 PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+"); 175 176 PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2", 177 "+"); 178 PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3", 179 "+"); 180 PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1", 181 "-" ); 182 PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0, 183 """-"" - 2", "-"); 184 PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3", 185 "-"); 186 187 SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2; 188 TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER; 189 VSTR : STR (0 .. 1) := "AB"; 190 191 PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) & 192 VSTR (1 .. 1), 193 VSTR (0 .. 0), 194 VSTR (1 .. 1), """&"" - 1", "&"); 195 196 PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) & 197 VSTR (0 .. 0), 198 VSTR (1 .. 1), 199 VSTR (0 .. 0), """&"" - 2", "&"); 200 201 PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*"); 202 203 PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2", 204 "*"); 205 PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/"); 206 207 PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2", 208 "/"); 209 PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM"); 210 211 PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD"); 212 213 PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS"); 214 215 PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2", 216 "ABS"); 217 218 PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3", 219 "ABS"); 220 221 PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1", 222 "**"); 223 224 PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2", 225 "**"); 226 227 BEGIN 228 NULL; 229 END; 230 231 DECLARE -- CHECKS WITH ATTRIBUTES. 232 233 TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI); 234 235 PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC", 236 WEEKDAY'SUCC); 237 238 PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED", 239 WEEKDAY'PRED); 240 241 PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR", 242 "WEEKDAY'IMAGE", WEEKDAY'IMAGE); 243 244 PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI, 245 "WEEKDAY'VALUE", WEEKDAY'VALUE); 246 BEGIN 247 NULL; 248 END; 249 250 RESULT; 251END CC3601A; 252