Subversion Repositories openrisc

-- C37405A.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 WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED

-- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT

-- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED

-- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER.

-- ASL 7/21/81

-- TBN 1/20/86     RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS 

--                 OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND

--                 RECORD COMPONENTS.

WITH REPORT; USE REPORT;

PROCEDURE C37405A IS

     TYPE REC(DISC : INTEGER := 25) IS

          RECORD

               COMP : INTEGER;

          END RECORD;

     SUBTYPE CONSTR IS REC(10);

     SUBTYPE UNCONSTR IS REC;

     TYPE REC_C IS

          RECORD

               COMP: CONSTR;

          END RECORD;

     TYPE REC_U IS

          RECORD

               COMP: UNCONSTR;

          END RECORD;

     C1,C2 : CONSTR;

     U1,U2 : UNCONSTR;

-- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2.

     ARR_C : ARRAY (1..5) OF CONSTR;

     ARR_U : ARRAY (1..5) OF UNCONSTR;

     REC_COMP_C : REC_C;

     REC_COMP_U : REC_U;

     PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS

     BEGIN

          PARM := C2;

          IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN

               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &

                       "ASSIGNMENT - 1");

          END IF;

     END PROC11;

     PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS

     BEGIN

          PARM := U2;

          IF B /= PARM'CONSTRAINED THEN

               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &

                       "ASSIGNMENT - 2");

          END IF;

     END PROC12;

     PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS

     BEGIN

          IF B /= PARM'CONSTRAINED THEN

               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &

                       "PASSING PARAMETER");

          END IF;

          PROC11(PARM, B);

          PROC12(PARM, B);

     END PROC1;

     PROCEDURE PROC2(PARM : IN OUT CONSTR) IS

     BEGIN

          COMMENT ("CALLING PROC1 FROM PROC2");   -- IN CASE TEST FAILS.

          PROC1(PARM,TRUE);

          PARM := U2;

          IF NOT PARM'CONSTRAINED THEN

               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &

                       "ASSIGNMENT - 3");

          END IF;

     END PROC2;

BEGIN

     TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &

                     "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");

     C2 := (DISC => IDENT_INT(10), COMP => 3);

     U2 := (DISC => IDENT_INT(10), COMP => 4);

     ARR_C := (1..5 => U2);

     ARR_U := (1..5 => C2);

     REC_COMP_C := (COMP => U2);

     REC_COMP_U := (COMP => C2);

     C1 := U2;

     U1 := C2;

     IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN

          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");

     END IF;

     IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN

          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");

     END IF;

     IF REC_COMP_U.COMP'CONSTRAINED

         OR NOT REC_COMP_C.COMP'CONSTRAINED THEN

          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");

     END IF;

     COMMENT("CALLING PROC1 DIRECTLY");

     PROC1(C1,TRUE);

     PROC2(C1);

     COMMENT("CALLING PROC1 DIRECTLY");

     PROC1(U1,FALSE);

     PROC2(U1);

     COMMENT("CALLING PROC1 DIRECTLY");

     PROC1(ARR_C(4), TRUE);

     PROC2(ARR_C(5));

     COMMENT("CALLING PROC1 DIRECTLY");

     PROC1(ARR_U(2), FALSE);

     PROC2(ARR_U(3));

     COMMENT("CALLING PROC1 DIRECTLY");

     PROC1(REC_COMP_C.COMP, TRUE);

     PROC2(REC_COMP_C.COMP);

     COMMENT("CALLING PROC1 DIRECTLY");

     PROC1(REC_COMP_U.COMP, FALSE);

     PROC2(REC_COMP_U.COMP);

     RESULT;

END C37405A;