Subversion Repositories openrisc_me

-- CC1225A.TST

--                             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, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS

--     ARE IMPLICITLY DECLARED.

-- MACRO SUBSTITUTION:

--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR

--     THE ACTIVATION OF A TASK.

-- HISTORY:

--     BCB 03/29/88  CREATED ORIGINAL TEST.

--     RDH 04/09/90  ADDED 'STORAGE_SIZE CLAUSES.  CHANGED EXTENSION TO

--                   'TST'.

--     LDC 09/26/90  REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T

--                   NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO

--                   NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS,

--                   CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL.

--     LDC 10/13/90  CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR

--                   AVAILABILITY.  CHANGED CHECK FOR 'ADDRESS TO A

--                   MEMBERSHIP TEST.

--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.

WITH REPORT; USE REPORT;

WITH SYSTEM; USE SYSTEM;

PROCEDURE CC1225A IS

     TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;

     TYPE AI IS ACCESS INTEGER;

     TYPE ACCINTEGER IS ACCESS INTEGER;

     TYPE REC IS RECORD

          COMP : INTEGER;

     END RECORD;

     TYPE DISCREC (DISC : INTEGER := 1) IS RECORD

          COMPD : INTEGER;

     END RECORD;

     TYPE AREC IS ACCESS REC;

     TYPE ADISCREC IS ACCESS DISCREC;

     TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER;

     TYPE ONEDIM IS ARRAY(1..10) OF INTEGER;

     TYPE AA IS ACCESS ARR;

     TYPE AONEDIM IS ACCESS ONEDIM;

     TYPE ENUM IS (ONE, TWO, THREE);

     TASK TYPE T IS

          ENTRY HERE(VAL : IN OUT INTEGER);

     END T;

     TYPE ATASK IS ACCESS T;

     TYPE ANOTHERTASK IS ACCESS T;

     FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE;

     TASK TYPE T1 IS

          ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER);

     END T1;

     TYPE ATASK1 IS ACCESS T1;

     TASK BODY T IS

     BEGIN

          ACCEPT HERE(VAL : IN OUT INTEGER) DO

               VAL := VAL * 2;

          END HERE;

     END T;

     TASK BODY T1 IS

     BEGIN

          SELECT

               ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO

                    VAL1 := VAL1 * 1;

               END HERE1;

          OR

               ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO

                    VAL1 := VAL1 * 2;

               END HERE1;

          OR

               ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO

                    VAL1 := VAL1 * 3;

               END HERE1;

          END SELECT;

     END T1;

     GENERIC

          TYPE FORM IS (<>);

          TYPE ACCFORM IS ACCESS FORM;

          TYPE ACC IS ACCESS INTEGER;

          TYPE ACCREC IS ACCESS REC;

          TYPE ACCDISCREC IS ACCESS DISCREC;

          TYPE ACCARR IS ACCESS ARR;

          TYPE ACCONE IS ACCESS ONEDIM;

          TYPE ACCTASK IS ACCESS T;

          TYPE ACCTASK1 IS ACCESS T1;

          TYPE ANOTHERTASK1 IS ACCESS T;

     PACKAGE P IS

     END P;

     PACKAGE BODY P IS

          AF : ACCFORM;

          TYPE DER_ACC IS NEW ACC;

          A, B : ACC;

          DERA : DER_ACC;

          R : ACCREC;

          DR : ACCDISCREC;

          C : ACCARR;

          D, E : ACCONE;

          F : ACCTASK;

          G : ACCTASK1;

          INT : INTEGER := 5;

     BEGIN

          TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " &

                           "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " &

                           "DECLARED");

          IF AF'ADDRESS NOT IN ADDRESS THEN

               FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST");

          END IF;

          DECLARE

               AF_SIZE : INTEGER := ACCFORM'SIZE;

          BEGIN

               IF AF_SIZE NOT IN INTEGER THEN

                    FAILED ("IMPROPER RESULT FROM AF'SIZE");

               END IF;

          END;

          IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN

               FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE");

          END IF;

          B := NEW INTEGER'(25);

          A := B;

          IF A.ALL /= 25 THEN

               FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " &

                       "OF A FORMAL ACCESS TYPE FROM ANOTHER " &

                       "VARIABLE OF A FORMAL ACCESS TYPE");

          END IF;

          A := NEW INTEGER'(10);

          IF A.ALL /= 10 THEN

               FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " &

                       "TYPE");

          END IF;

          IF A NOT IN ACC THEN

               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");

          END IF;

          B := ACC'(A);

          IF B.ALL /= 10 THEN

               FAILED ("IMPROPER VALUE FROM QUALIFICATION");

          END IF;

          DERA := NEW INTEGER'(10);

          A := ACC(DERA);

          IF A.ALL /= IDENT_INT(10) THEN

               FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION");

          END IF;

          IF A.ALL > IDENT_INT(10) THEN

               FAILED ("IMPROPER VALUE USED IN LESS THAN");

          END IF;

          IF A.ALL < IDENT_INT(10) THEN

               FAILED ("IMPROPER VALUE USED IN GREATER THAN");

          END IF;

          IF A.ALL >= IDENT_INT(11) THEN

               FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL");

          END IF;

          IF A.ALL <= IDENT_INT(9) THEN

               FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL");

          END IF;

          IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN

               FAILED ("IMPROPER VALUE FROM ADDITION");

          END IF;

          IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN

               FAILED ("IMPROPER VALUE FROM SUBTRACTION");

          END IF;

          IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN

               FAILED ("IMPROPER VALUE FROM MULTIPLICATION");

          END IF;

          IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN

               FAILED ("IMPROPER VALUE FROM DIVISION");

          END IF;

          IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN

               FAILED ("IMPROPER VALUE FROM MODULO");

          END IF;

          IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN

               FAILED ("IMPROPER VALUE FROM REMAINDER");

          END IF;

          IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN

               FAILED ("IMPROPER VALUE FROM EXPONENTIATION");

          END IF;

          IF NOT (+A.ALL = IDENT_INT(10)) THEN

               FAILED ("IMPROPER VALUE FROM IDENTITY");

          END IF;

          IF NOT (-A.ALL = IDENT_INT(-10)) THEN

               FAILED ("IMPROPER VALUE FROM NEGATION");

          END IF;

          A := NULL;

          IF A /= NULL THEN

               FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL");

          END IF;

          IF A'ADDRESS NOT IN ADDRESS THEN

               FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST");

          END IF;

          DECLARE

               ACC_SIZE : INTEGER := ACC'SIZE;

          BEGIN

               IF ACC_SIZE NOT IN INTEGER THEN

                    FAILED ("IMPROPER RESULT FROM ACC'SIZE");

               END IF;

          END;

          R := NEW REC'(COMP => 5);

          IF NOT EQUAL(R.COMP,5) THEN

               FAILED ("IMPROPER VALUE FOR RECORD COMPONENT");

          END IF;

          DR := NEW DISCREC'(DISC => 1, COMPD => 5);

          IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN

               FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " &

                       "COMPONENTS");

          END IF;

          C := NEW ARR'(1 => (1,2), 2 => (3,4));

          IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4

               THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES");

          END IF;

          D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10);

          E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1);

          D(1..5) := E(1..5);

          IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8

               OR D(4) /= 7 OR D(5) /= 6 THEN

               FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT");

          END IF;

          IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN

               FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY");

          END IF;

          IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN

               FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY");

          END IF;

          IF 1 NOT IN C'RANGE THEN

               FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1");

          END IF;

          IF 1 NOT IN C'RANGE(2) THEN

               FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2");

          END IF;

          IF C'LENGTH /= 2 THEN

               FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &

                       "ARRAY - 1");

          END IF;

          IF C'LENGTH(2) /= 2 THEN

               FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &

                       "ARRAY - 2");

          END IF;

          F := NEW T;

          F.HERE(INT);

          IF NOT EQUAL(INT,IDENT_INT(10)) THEN

               FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION");

          END IF;

          G := NEW T1;

          G.HERE1(TWO)(INT);

          IF NOT EQUAL(INT,IDENT_INT(20)) THEN

               FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION");

          END IF;

          RESULT;

     END P;

     PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC,

                           AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK);

BEGIN

     NULL;

END CC1225A;