Subversion Repositories openrisc_me

-- CC3017B.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 INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
-- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
-- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
-- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
-- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE     
-- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.   
 
--   SUBTESTS ARE:
--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
--            INITIALIZED WITH A STATIC AGGREGATE.
--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
--            INITIALIZED WITH A STATIC VALUE.
--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
--            WITH A STATIC AGGREGATE.
--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
--            INITIALIZED WITH A STATIC AGGREGATE.
 
-- EDWARD V. BERARD, 7 AUGUST 1990
 
WITH REPORT;
 
PROCEDURE CC3017B IS
 
BEGIN
 
     REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
                  "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
                  "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
                  "CONSTRAINTS ON A FORMAL PARAMETER");
 
     --------------------------------------------------
 
     NONSTAT_ARRAY_PARMS:
 
     DECLARE
 
--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
--            INITIALIZED WITH A STATIC AGGREGATE.
 
          TYPE NUMBER IS RANGE 1 .. 100 ;
 
          GENERIC
 
            TYPE INTEGER_TYPE IS RANGE <> ;
            LOWER : IN INTEGER_TYPE ;
            UPPER : IN INTEGER_TYPE ;
 
          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
                        SECOND : IN INTEGER_TYPE) ;
 
          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
                        SECOND : IN INTEGER_TYPE) IS
 
               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
                                 INTEGER_TYPE RANGE LOWER .. SECOND)
                                         OF INTEGER_TYPE;
 
               PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
                    IS
               BEGIN
                    REPORT.FAILED ("BODY OF PA1 EXECUTED");
               EXCEPTION
                    WHEN OTHERS =>
                         REPORT.FAILED ("EXCEPTION RAISED IN PA1");
               END PA1;
 
          BEGIN  -- PA
               PA1;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
          END PA;
 
          PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
                                      LOWER        => 1,
                                      UPPER        => 50) ;
 
     BEGIN   -- NONSTAT_ARRAY_PARMS
 
          NEW_PA (FIRST  => NUMBER (25),
                  SECOND => NUMBER (75));
 
     EXCEPTION
          WHEN OTHERS =>
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
 
     END NONSTAT_ARRAY_PARMS ;   
 
     --------------------------------------------------
 
     SCALAR_NON_STATIC:
 
     DECLARE
 
--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
--            INITIALIZED WITH A STATIC VALUE.
 
          TYPE NUMBER IS RANGE 1 .. 100 ;
 
          GENERIC
 
            TYPE INTEGER_TYPE IS RANGE <> ;
            STATIC_VALUE : IN INTEGER_TYPE ;
 
          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
                        UPPER  : IN INTEGER_TYPE) ;
 
          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
                        UPPER  : IN INTEGER_TYPE) IS
 
               SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
 
               PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
               BEGIN  -- PB1
                    REPORT.FAILED ("BODY OF PB1 EXECUTED");
               EXCEPTION
                    WHEN OTHERS =>
                         REPORT.FAILED ("EXCEPTION RAISED IN PB1");
               END PB1;
 
          BEGIN  -- PB
               PB1;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
          END PB;
 
          PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
                                      STATIC_VALUE => 20) ;
 
     BEGIN   -- SCALAR_NON_STATIC
 
          NEW_PB (LOWER  => NUMBER (25),
                  UPPER  => NUMBER (75));
 
     EXCEPTION
          WHEN OTHERS =>
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
     END SCALAR_NON_STATIC ; 
 
     --------------------------------------------------
 
     REC_NON_STAT_COMPS:
 
     DECLARE
 
--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
 
          TYPE NUMBER IS RANGE 1 .. 100 ;
 
          GENERIC
 
            TYPE INTEGER_TYPE IS RANGE <> ;
            F_STATIC_VALUE : IN INTEGER_TYPE ;
            S_STATIC_VALUE : IN INTEGER_TYPE ;
            T_STATIC_VALUE : IN INTEGER_TYPE ;
            L_STATIC_VALUE : IN INTEGER_TYPE ;
 
          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
                        UPPER  : IN INTEGER_TYPE) ;
 
          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
                        UPPER  : IN INTEGER_TYPE) IS
 
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
                       RANGE LOWER .. UPPER ;
               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
                     SUBINTEGER_TYPE ;
               TYPE REC IS
                    RECORD
                         FIRST  : SUBINTEGER_TYPE ;
                         SECOND : AR1 ;
                    END RECORD;
 
               PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
                                         (S_STATIC_VALUE,
                                          T_STATIC_VALUE,
                                          L_STATIC_VALUE))) IS
               BEGIN  -- PC1
                    REPORT.FAILED ("BODY OF PC1 EXECUTED");
               EXCEPTION
                    WHEN OTHERS =>
                         REPORT.FAILED ("EXCEPTION RAISED IN PC1");
               END PC1;
 
          BEGIN  -- PC
               PC1;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
          END PC;
 
          PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
                                      F_STATIC_VALUE => 15,
                                      S_STATIC_VALUE => 19,
                                      T_STATIC_VALUE => 85,
                                      L_STATIC_VALUE => 99) ;
 
     BEGIN   -- REC_NON_STAT_COMPS
          NEW_PC (LOWER => 20,
                  UPPER => 80);
     EXCEPTION
          WHEN OTHERS =>
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
     END REC_NON_STAT_COMPS ;
 
     --------------------------------------------------
 
     FIRST_STATIC_ARRAY:
 
     DECLARE
 
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
--            WITH A STATIC AGGREGATE.
 
          TYPE NUMBER IS RANGE 1 .. 100 ;
 
          GENERIC
 
            TYPE INTEGER_TYPE IS RANGE <> ;
            F_STATIC_VALUE : IN INTEGER_TYPE ;
            S_STATIC_VALUE : IN INTEGER_TYPE ;
            T_STATIC_VALUE : IN INTEGER_TYPE ;
            L_STATIC_VALUE : IN INTEGER_TYPE ;
            A_STATIC_VALUE : IN INTEGER_TYPE ;
            B_STATIC_VALUE : IN INTEGER_TYPE ;
            C_STATIC_VALUE : IN INTEGER_TYPE ;
            D_STATIC_VALUE : IN INTEGER_TYPE ;
 
          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
                         UPPER  : IN INTEGER_TYPE) ;
 
          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
                         UPPER  : IN INTEGER_TYPE) IS
 
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
                       RANGE LOWER .. UPPER ;
 
               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
                                       F_STATIC_VALUE .. S_STATIC_VALUE,
                                 INTEGER_TYPE RANGE
                                       T_STATIC_VALUE .. L_STATIC_VALUE)
                       OF SUBINTEGER_TYPE ;
 
               PROCEDURE P1D1 (A : A1 :=
                           ((A_STATIC_VALUE, B_STATIC_VALUE),
                           (C_STATIC_VALUE, D_STATIC_VALUE))) IS
               BEGIN  -- P1D1
                    REPORT.FAILED ("BODY OF P1D1 EXECUTED");
               EXCEPTION
                    WHEN OTHERS =>
                         REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
               END P1D1;
 
          BEGIN  -- P1D
               P1D1 ;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
          END P1D;
 
          PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
                                        F_STATIC_VALUE => 21,
                                        S_STATIC_VALUE => 37,
                                        T_STATIC_VALUE => 67,
                                        L_STATIC_VALUE => 79,
                                        A_STATIC_VALUE => 11,
                                        B_STATIC_VALUE => 88,
                                        C_STATIC_VALUE => 87,
                                        D_STATIC_VALUE => 13) ;
 
     BEGIN  -- FIRST_STATIC_ARRAY
          NEW_P1D (LOWER => 10,
                     UPPER => 90);
     EXCEPTION
          WHEN OTHERS =>
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
     END FIRST_STATIC_ARRAY ;
 
     --------------------------------------------------
 
     SECOND_STATIC_ARRAY:
 
     DECLARE
 
--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
--            WITH A STATIC AGGREGATE.
 
          TYPE NUMBER IS RANGE 1 .. 100 ;
 
          GENERIC
 
            TYPE INTEGER_TYPE IS RANGE <> ;
            F_STATIC_VALUE : IN INTEGER_TYPE ;
            S_STATIC_VALUE : IN INTEGER_TYPE ;
            T_STATIC_VALUE : IN INTEGER_TYPE ;
            L_STATIC_VALUE : IN INTEGER_TYPE ;
            A_STATIC_VALUE : IN INTEGER_TYPE ;
            B_STATIC_VALUE : IN INTEGER_TYPE ;
 
          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
                         UPPER  : IN INTEGER_TYPE) ;
 
          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
                         UPPER  : IN INTEGER_TYPE) IS
 
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
                       RANGE LOWER .. UPPER ;
 
               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
                                       F_STATIC_VALUE .. S_STATIC_VALUE,
                                 INTEGER_TYPE RANGE
                                       T_STATIC_VALUE .. L_STATIC_VALUE)
                       OF SUBINTEGER_TYPE ;
 
               PROCEDURE P2D1 (A : A1 :=
                                   (F_STATIC_VALUE .. S_STATIC_VALUE =>
                                   (A_STATIC_VALUE, B_STATIC_VALUE))) IS
               BEGIN  -- P2D1
                    REPORT.FAILED ("BODY OF P2D1 EXECUTED");
               EXCEPTION
                    WHEN OTHERS =>
                         REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
               END P2D1;
 
          BEGIN  -- P2D
               P2D1;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
          END P2D;
 
          PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
                                        F_STATIC_VALUE => 21,
                                        S_STATIC_VALUE => 37,
                                        T_STATIC_VALUE => 67,
                                        L_STATIC_VALUE => 79,
                                        A_STATIC_VALUE => 7,
                                        B_STATIC_VALUE => 93) ;
 
     BEGIN  -- SECOND_STATIC_ARRAY
          NEW_P2D (LOWER => 5,
                   UPPER => 95);
     EXCEPTION
          WHEN OTHERS =>
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
     END SECOND_STATIC_ARRAY ;
 
     --------------------------------------------------
 
     REC_NON_STATIC_CONS:
 
     DECLARE
 
--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
--            INITIALIZED WITH A STATIC AGGREGATE.
 
          TYPE NUMBER IS RANGE 1 .. 100 ;
 
          GENERIC
 
            TYPE INTEGER_TYPE IS RANGE <> ;
            F_STATIC_VALUE : IN INTEGER_TYPE ;
            S_STATIC_VALUE : IN INTEGER_TYPE ;
            T_STATIC_VALUE : IN INTEGER_TYPE ;
            L_STATIC_VALUE : IN INTEGER_TYPE ;
            D_STATIC_VALUE : IN INTEGER_TYPE ;
 
          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
                        UPPER  : IN INTEGER_TYPE) ;
 
          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
                        UPPER  : IN INTEGER_TYPE) IS
 
               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
                       RANGE LOWER .. UPPER ;
               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
                     SUBINTEGER_TYPE ;
 
               TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
                    RECORD
                         FIRST  : SUBINTEGER_TYPE ;
                         SECOND : AR1 ;
                    END RECORD ;
 
               SUBTYPE REC4 IS REC (LOWER) ;
 
               PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
                                           F_STATIC_VALUE,
                                          (S_STATIC_VALUE,
                                           T_STATIC_VALUE,
                                           L_STATIC_VALUE))) IS
               BEGIN  -- PE1
                    REPORT.FAILED ("BODY OF PE1 EXECUTED");
               EXCEPTION
                    WHEN OTHERS =>
                         REPORT.FAILED ("EXCEPTION RAISED IN PE1");
               END PE1;
 
          BEGIN  -- PE
               PE1;
          EXCEPTION
               WHEN CONSTRAINT_ERROR =>
                    NULL;
               WHEN OTHERS =>
                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
          END PE;
 
          PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
                                      F_STATIC_VALUE => 37,
                                      S_STATIC_VALUE => 21,
                                      T_STATIC_VALUE => 67,
                                      L_STATIC_VALUE => 79,
                                      D_STATIC_VALUE => 44) ;
 
     BEGIN  -- REC_NON_STATIC_CONS
          NEW_PE  (LOWER => 2,
                   UPPER => 99);
     EXCEPTION
          WHEN OTHERS =>
               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
     END REC_NON_STATIC_CONS ;
 
     --------------------------------------------------
 
     REPORT.RESULT;
 
END CC3017B;