-- CC3601A.ADA -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- CHECK THAT PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL -- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN -- CC3601C). -- R.WILLIAMS 10/9/86 -- JRL 11/15/95 Added unknown discriminant part to all formal -- private types. WITH REPORT; USE REPORT; PROCEDURE CC3601A IS GENERIC TYPE T (<>) IS PRIVATE; V, V1 : T; KIND : STRING; WITH FUNCTION F1 (X : IN T) RETURN T; PACKAGE GP1 IS R : BOOLEAN := F1 (V) = V1; END GP1; PACKAGE BODY GP1 IS BEGIN IF NOT (IDENT_BOOL(R)) THEN FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND); END IF; END GP1; GENERIC TYPE T (<>) IS PRIVATE; V, V1, V2 : IN T; KIND : STRING; WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T; PACKAGE GP2 IS R : BOOLEAN := V /= F1 (V1, V2); END GP2; PACKAGE BODY GP2 IS BEGIN IF IDENT_BOOL (R) THEN FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND); END IF; END GP2; GENERIC TYPE T1 (<>) IS PRIVATE; TYPE T2 (<>) IS PRIVATE; V1 : T1; V2 : T2; KIND : STRING; WITH FUNCTION F1 (X : IN T1) RETURN T2; PACKAGE GP3 IS R : BOOLEAN := F1 (V1) = V2; END GP3; PACKAGE BODY GP3 IS BEGIN IF NOT (IDENT_BOOL(R)) THEN FAILED ( "INCORRECT VALUE FOR OP - " & KIND); END IF; END GP3; BEGIN TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " & "PASSED AS ACTUAL GENERIC SUBPROGRAM " & "PARAMETERS" ); BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS -- ACTUAL PARAMETERS. FOR I1 IN BOOLEAN LOOP FOR I2 IN BOOLEAN LOOP COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " & "B2 = " & BOOLEAN'IMAGE (I2) ); DECLARE B1 : BOOLEAN := IDENT_BOOL (I1); B2 : BOOLEAN := IDENT_BOOL (I2); PACKAGE P1 IS NEW GP1 (BOOLEAN, NOT B2, B2, """NOT"" - 1", "NOT"); PACKAGE P2 IS NEW GP2 (BOOLEAN, B1 OR B2, B1, B2, "OR", "OR"); PACKAGE P3 IS NEW GP2 (BOOLEAN, B1 AND B2, B2, B1, "AND", "AND"); PACKAGE P4 IS NEW GP2 (BOOLEAN, B1 /= B2, B1, B2, "XOR", "XOR"); PACKAGE P5 IS NEW GP2 (BOOLEAN, B1 < B2, B1, B2, "<", "<"); PACKAGE P6 IS NEW GP2 (BOOLEAN, B1 <= B2, B1, B2, "<=", "<="); PACKAGE P7 IS NEW GP2 (BOOLEAN, B1 > B2, B1, B2, ">", ">"); PACKAGE P8 IS NEW GP2 (BOOLEAN, B1 >= B2, B1, B2, ">=", ">="); TYPE AB IS ARRAY (BOOLEAN RANGE <> ) OF BOOLEAN; AB1 : AB (BOOLEAN) := (B1, B2); AB2 : AB (BOOLEAN) := (B2, B1); T : AB (B1 .. B2) := (B1 .. B2 => TRUE); F : AB (B1 .. B2) := (B1 .. B2 => FALSE); VB1 : AB (B1 .. B1) := (B1 => B2); VB2 : AB (B2 .. B2) := (B2 => B1); PACKAGE P9 IS NEW GP1 (AB, AB1, NOT AB1, """NOT"" - 2", "NOT"); PACKAGE P10 IS NEW GP1 (AB, T, F, """NOT"" - 3", "NOT"); PACKAGE P11 IS NEW GP1 (AB, VB2, (B2 => NOT B1), """NOT"" - 4", "NOT"); PACKAGE P12 IS NEW GP2 (AB, AB1 AND AB2, AB1, AB2, "AND", "AND"); BEGIN NULL; END; END LOOP; END LOOP; END; DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", -- AND "ABS". PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+"); PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+"); PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3", "+"); PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-"); PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-"); PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3", "-"); PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+"); PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2", "+"); PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3", "+"); PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1", "-" ); PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0, """-"" - 2", "-"); PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3", "-"); SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2; TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER; VSTR : STR (0 .. 1) := "AB"; PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) & VSTR (1 .. 1), VSTR (0 .. 0), VSTR (1 .. 1), """&"" - 1", "&"); PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) & VSTR (0 .. 0), VSTR (1 .. 1), VSTR (0 .. 0), """&"" - 2", "&"); PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*"); PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2", "*"); PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/"); PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2", "/"); PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM"); PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD"); PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS"); PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2", "ABS"); PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3", "ABS"); PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1", "**"); PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2", "**"); BEGIN NULL; END; DECLARE -- CHECKS WITH ATTRIBUTES. TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI); PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC", WEEKDAY'SUCC); PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED", WEEKDAY'PRED); PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR", "WEEKDAY'IMAGE", WEEKDAY'IMAGE); PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI, "WEEKDAY'VALUE", WEEKDAY'VALUE); BEGIN NULL; END; RESULT; END CC3601A;