cc3017b.ada

来自「linux下编程用 编译软件」· ADA 代码 · 共 471 行 · 第 1/2 页

-- 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,