Subversion Repositories openrisc_me

-- C61010A.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 AN IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A

-- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.

-- DAS  1/22/81

-- JRK  1/20/84  TOTALLY REVISED.

WITH REPORT; USE REPORT;

PROCEDURE C61010A IS

     PACKAGE PKG IS

          TYPE ITYPE IS LIMITED PRIVATE;

          PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);

          PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;

                                  M : STRING);

          PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);

          SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;

          TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;

          PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;

                                S : STRING; M : STRING);

          PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;

                                   I : INTEGER; S : STRING;

                                   M : STRING);

          PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;

                            S : STRING);

     PRIVATE

          TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;

          TYPE VRTYPE (C : INT_0_20 := 20) IS

               RECORD

                    I : INTEGER;

                    S : STRING (1 .. C);

               END RECORD;

     END PKG;

     USE PKG;

     I1 : ITYPE;

     TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;

     A1 : ATYPE;

     VR1 : VRTYPE;

     D : CONSTANT INT_0_20 := 10;

     TYPE RTYPE IS

          RECORD

               J : ITYPE;

               R : VRTYPE (D);

          END RECORD;

     R1 : RTYPE;

     PACKAGE BODY PKG IS

          PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS

          BEGIN

               IF INTEGER (X) /= V THEN

                    FAILED ("WRONG SCALAR VALUE - " & M);

               END IF;

          END LOOK_IN_I;

          PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;

                                  M : STRING) IS

          BEGIN

               IF INTEGER (X) /= V THEN

                    FAILED ("WRONG SCALAR VALUE - " & M);

               END IF;

          END LOOK_INOUT_I;

          PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS

          BEGIN

               X := ITYPE (IDENT_INT (V));

          END SET_I;

          PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;

                                S : STRING; M : STRING) IS

          BEGIN

               IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN

                    FAILED ("WRONG COMPOSITE VALUE - " & M);

               END IF;

          END LOOK_IN_VR;

          PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;

                                   I : INTEGER; S : STRING;

                                   M : STRING) IS

          BEGIN

               IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN

                    FAILED ("WRONG COMPOSITE VALUE - " & M);

               END IF;

          END LOOK_INOUT_VR;

          PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;

                            S : STRING) IS

          BEGIN

               X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));

          END SET_VR;

     BEGIN

          I1 := ITYPE (IDENT_INT(2));

          FOR I IN A1'RANGE LOOP

               A1 (I) := ITYPE (3 + IDENT_INT(I));

          END LOOP;

          VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));

          R1.J := ITYPE (IDENT_INT(6));

          R1.R := (IDENT_INT(D), IDENT_INT(19),

                   IDENT_STR("ABCDEFGHIJ"));

     END PKG;

     PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS

     BEGIN

          LOOK_IN_I (X, V, M);

     END CHECK_IN_I;

     PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;

                              NV : INTEGER; M : STRING) IS

     BEGIN

          LOOK_INOUT_I (X, OV, M & " - A");

          SET_I (X, NV);

          LOOK_INOUT_I (X, NV, M & " - B");

          LOOK_IN_I (X, NV, M & " - C");

     END CHECK_INOUT_I;

     PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS

     BEGIN

          FOR I IN X'RANGE LOOP

               LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));

          END LOOP;

     END CHECK_IN_A;

     PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;

                              NV : INTEGER; M : STRING) IS

     BEGIN

          FOR I IN X'RANGE LOOP

               LOOK_INOUT_I (X(I), OV+I, M & " - A" &

                                         INTEGER'IMAGE (I));

               SET_I (X(I), NV+I);

               LOOK_INOUT_I (X(I), NV+I, M & " - B" &

                                         INTEGER'IMAGE (I));

               LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));

          END LOOP;

     END CHECK_INOUT_A;

     PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;

                            S : STRING; M : STRING) IS

     BEGIN

          LOOK_IN_VR (X, C, I, S, M);

     END CHECK_IN_VR;

     PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;

                               OC : INTEGER; OI : INTEGER; OS : STRING;

                               NC : INTEGER; NI : INTEGER; NS : STRING;

                               M : STRING) IS

     BEGIN

          LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");

          SET_VR (X, NC, NI, NS);

          LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");

          LOOK_IN_VR (X, NC, NI, NS, M & " - C");

     END CHECK_INOUT_VR;

     PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;

                           I : INTEGER; S : STRING; M : STRING) IS

     BEGIN

          LOOK_IN_I (X.J, J, M & " - A");

          LOOK_IN_VR (X.R, C, I, S, M & " - B");

     END CHECK_IN_R;

     PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;

                              OC : INTEGER; OI : INTEGER; OS : STRING;

                              NJ : INTEGER;

                              NC : INTEGER; NI : INTEGER; NS : STRING;

                              M : STRING) IS

     BEGIN

          LOOK_INOUT_I (X.J, OJ, M & " - A");

          LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");

          SET_I (X.J, NJ);

          SET_VR (X.R, NC, NI, NS);

          LOOK_INOUT_I (X.J, NJ, M & " - C");

          LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");

          LOOK_IN_I (X.J, NJ, M & " - E");

          LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");

     END CHECK_INOUT_R;

BEGIN

     TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &

                      "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");

     CHECK_IN_I (I1, 2, "IN I");

     CHECK_INOUT_I (I1, 2, 5, "INOUT I");

     CHECK_IN_A (A1, 3, "IN A");

     CHECK_INOUT_A (A1, 3, 17, "INOUT A");

     CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");

     CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",

                     "INOUT VR");

     CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");

     CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",

                    "INOUT R");

     RESULT;

END C61010A;