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