Subversion Repositories openrisc

-- CC1220A.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.

--*

-- OBJECTIVE:

--     CHECK THAT A GENERIC UNIT CAN REFER TO AN IMPLICITLY

--     DECLARED PREDEFINED OPERATOR.

-- HISTORY:

--     DAT 08/20/81  CREATED ORIGINAL TEST.

--     SPS 05/03/82

--     BCB 08/04/88  MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER

--                   OPERATIONS OF A DISCRETE TYPE.

--     RJW 03/27/90  REVISED TEST TO CHECK FOR A GENERIC FORMAL

--                   DISCRETE TYPE.

--     CJJ 10/14/90  ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=);

--                   MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC.

WITH REPORT; USE REPORT;

WITH SYSTEM; USE SYSTEM;

PROCEDURE CC1220A IS

BEGIN

     TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " &

           "DECLARED OPERATORS");

     DECLARE

          GENERIC

               TYPE T IS (<>);

               STR : STRING;

               P1 : T := T'FIRST;

               P2 : T := T(T'SUCC (P1));

               P3 : T := T'(T'PRED (P2));

               P4 : INTEGER := IDENT_INT(T'WIDTH);

               P5 : BOOLEAN := (P1 < P2) AND (P2 > P3);

               P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1);

               P7 : BOOLEAN := (P3 = P1);

               P8 : T := T'BASE'FIRST;

               P10 : T := T'LAST;

               P11 : INTEGER := T'SIZE;

               P12 : ADDRESS := P10'ADDRESS;

               P13 : INTEGER := T'WIDTH;

               P14 : INTEGER := T'POS(T'LAST);

               P15 : T := T'VAL(1);

               P16 : INTEGER := T'POS(P15);

               P17 : STRING := T'IMAGE(T'BASE'LAST);

               P18 : T := T'VALUE(P17);

               P19 : BOOLEAN := (P15 IN T);

               WITH FUNCTION IDENT (X : T) RETURN T;

          PACKAGE PKG IS

               ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3);

               B1 : BOOLEAN := P7 AND P19;

               B2 : BOOLEAN := P5 AND P6;

          END PKG;

          PACKAGE BODY PKG IS

          BEGIN

               IF P1 /= T(T'FIRST) THEN

                    FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR);

               END IF;

               IF T'SUCC (P1) /= IDENT (P2) OR

                  T'PRED (P2) /= IDENT (P1) THEN

                    FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR);

               END IF;

               IF P10 /= T(T'LAST) THEN

                    FAILED ("IMPROPER VALUE FOR 'LAST - " & STR);

               END IF;

               IF NOT EQUAL(P11,T'SIZE) THEN

                    FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR);

               END IF;

               IF NOT EQUAL(P13,T'WIDTH) THEN

                    FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR);

               END IF;

               IF NOT EQUAL (P16, T'POS (P15)) OR

                  T'VAL (P16) /= T(IDENT (P15)) THEN

                    FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR);

               END IF;

               IF T'VALUE (P17) /= T'BASE'LAST OR

                  T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN

                    FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " &

                             STR);

               END IF;

          END PKG;

     BEGIN

          DECLARE

               TYPE CHAR IS ('A', 'B', 'C', 'D', 'E');

               FUNCTION IDENT (C : CHAR) RETURN CHAR IS

               BEGIN

                    RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C)));

               END IDENT;

               PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR",

                                          IDENT => IDENT);

          BEGIN

               IF N_CHAR.ARR (1) /= IDENT ('A') OR

                  N_CHAR.ARR (2) /= IDENT ('B') OR

                  N_CHAR.ARR (3) /= 'A' OR

                  N_CHAR.B1 /= TRUE OR

                 N_CHAR.B2 /= TRUE THEN

                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &

                            " IN INSTANTIATION OF N_CHAR.");

               END IF;

          END;

          DECLARE

               TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC);

               FUNCTION IDENT (C : ENUM) RETURN ENUM IS

               BEGIN

                    RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C)));

               END IDENT;

               PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM",

                                          IDENT => IDENT);

          BEGIN

               IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR

                  N_ENUM.ARR (2) /= IDENT (ADA) OR

                  N_ENUM.ARR (3) /= JOVIAL OR

                  N_ENUM.B1 /= TRUE OR

                  N_ENUM.B2 /= TRUE THEN

                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &

                            " IN INSTANTIATION OF N_ENUM.");

               END IF;

          END;

          DECLARE

               PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER",

                                          IDENT => IDENT_INT);

          BEGIN

               IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR

                  N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR

                  N_INT.ARR (3) /= INTEGER'FIRST OR

                  N_INT.B1 /= TRUE OR

                  N_INT.B2 /= TRUE THEN

                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &

                            " IN INSTANTIATION OF N_INT.");

               END IF;

          END;

     END;

     RESULT;

END CC1220A;