Subversion Repositories openrisc

-- C64103D.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 THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS

-- ON OUT ARRAY PARAMETERS.  IN PARTICULAR:

--   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL

--       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S

--       CONSTRAINTS.

--   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO

--       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE

--       OUTSIDE OF A FORMAL INDEX SUBTYPE.

--   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A

--       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER

--       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.

--   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN

--       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE

--       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.

-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X

-- ***       remove incompatibilities associated with the transition   -- 9X

-- ***       to Ada 9X.                                                -- 9X

-- ***                                                                 -- 9X

-- CPP 07/19/84

-- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO

--               AI-00387.

-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY

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

WITH SYSTEM;

WITH REPORT;  USE REPORT;

PROCEDURE C64103D IS

     BEGIN

     TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &

           "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS");

     -----------------------------------------------

     DECLARE   -- (A)

     BEGIN     -- (A)

          DECLARE

               TYPE SUBINT IS RANGE 0..8;

               TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;

               A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);

               PROCEDURE P2 (X : OUT ARRAY_TYPE) IS

               BEGIN

                    NULL;

               END P2;

          BEGIN

               P2 (ARRAY_TYPE (A0));                  -- OK.

          EXCEPTION

               WHEN OTHERS =>

                    FAILED ("EXCEPTION RAISED -P2 (A)");

          END;

     END; -- (A)

     -----------------------------------------------

     DECLARE   -- (B)

          TYPE SUBINT IS RANGE 0..8;

          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;

          TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;

          A1 : AR1 (-1..7) := (-1..7 => TRUE);

          A2 : AR1 (1..9) := (1..9 => TRUE);

          PROCEDURE P1 (X : OUT ARRAY_TYPE) IS

          BEGIN

               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");

          END P1;

     BEGIN     -- (B)

          BEGIN

               COMMENT ("CALL TO P1 (B) ON A1");

               P1 (ARRAY_TYPE (A1));

          EXCEPTION

               WHEN CONSTRAINT_ERROR =>

                    NULL;

               WHEN OTHERS =>

                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");

          END;

          BEGIN

               COMMENT ("CALL TO P1 (B) ON A2");

               P1 (ARRAY_TYPE (A2));

          EXCEPTION

               WHEN CONSTRAINT_ERROR =>

                    NULL;

               WHEN OTHERS =>

                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");

          END;

     END; -- (B)

     -----------------------------------------------

     DECLARE   -- (C)

     BEGIN     -- (C)

          DECLARE

               TYPE INDEX1 IS RANGE 1..3;

               TYPE INDEX2 IS RANGE 1..4;

               TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;

               A0 : AR_TYPE := (1..3 => (1..4 => FALSE));

               TYPE I1 IS RANGE 1..4;

               TYPE I2 IS RANGE 1..3;

               TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;

               PROCEDURE P1 (X : OUT ARRAY_TYPE) IS

               BEGIN

                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");

               END P1;

          BEGIN

               P1 (ARRAY_TYPE (A0));

          EXCEPTION

               WHEN CONSTRAINT_ERROR =>

                    NULL;

               WHEN OTHERS =>

                    FAILED ("WRONG EXCEPTION RAISED -P1 (C)");

          END;

     END; -- (C)

     -----------------------------------------------

     DECLARE   -- (D)

     BEGIN     -- (D)

          DECLARE

               TYPE SM_INT IS RANGE 0..2;

               TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;

               TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;

               TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;

               A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=

                    (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);

               PROCEDURE P1 (X : OUT AR_SMALL) IS

               BEGIN

                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");

               END P1;

          BEGIN

               IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN

                    P1 (AR_SMALL (A0));

               ELSE

                    COMMENT ("NOT APPLICABLE -P1 (D)");

               END IF;

          EXCEPTION

               WHEN CONSTRAINT_ERROR =>

                    COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");

               WHEN OTHERS =>

                    FAILED ("WRONG EXCEPTION RAISED - P1 (D)");

          END;

     END; -- (D)

     -----------------------------------------------

     RESULT;

END C64103D;