cc3605a.ada

来自「linux下编程用 编译软件」· ADA 代码 · 共 382 行

-- CC3605A.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.
--*
-- OBJECTIVE:
--     CHECK THAT SOME DIFFERENCES BETWEEN THE FORMAL AND THE
--     ACTUAL SUBPROGRAMS DO NOT INVALIDATE A MATCH.
--          1)  CHECK DIFFERENT PARAMETER NAMES.
--          2)  CHECK DIFFERENT PARAMETER CONSTRAINTS.
--          3)  CHECK ONE PARAMETER CONSTRAINED AND THE OTHER
--               UNCONSTRAINED (WITH ARRAY, RECORD, ACCESS, AND
--               PRIVATE TYPES).
--          4)  CHECK PRESENCE OR ABSENCE OF AN EXPLICIT "IN" MODE
--               INDICATOR.
--          5)  DIFFERENT TYPE MARKS USED TO SPECIFY THE TYPE OF
--               PARAMETERS.

-- HISTORY:
--     LDC 10/04/88  CREATED ORIGINAL TEST.

PACKAGE CC3605A_PACK IS

     SUBTYPE INT IS INTEGER RANGE -100 .. 100;

     TYPE PRI_TYPE (SIZE : INT) IS PRIVATE;

     SUBTYPE PRI_CONST IS PRI_TYPE (2);

PRIVATE

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

     TYPE PRI_TYPE (SIZE : INT) IS
          RECORD
               SUB_A : ARR_TYPE (1 .. SIZE);
          END RECORD;

END CC3605A_PACK;


WITH REPORT;
USE  REPORT;
WITH CC3605A_PACK;
USE  CC3605A_PACK;

PROCEDURE CC3605A IS

     SUBTYPE ZERO_TO_TEN IS INTEGER
          RANGE IDENT_INT (0) .. IDENT_INT (10);

     SUBTYPE ONE_TO_FIVE IS INTEGER
          RANGE IDENT_INT (1) .. IDENT_INT (5);

     SUBPRG_ACT : BOOLEAN := FALSE;
BEGIN
     TEST
          ("CC3605A", "CHECK THAT SOME DIFFERENCES BETWEEN THE " &
                      "FORMAL AND THE ACTUAL PARAMETERS DO NOT " &
                      "INVALIDATE A MATCH");

----------------------------------------------------------------------
-- DIFFERENT PARAMETER NAMES
----------------------------------------------------------------------

     DECLARE

          PROCEDURE ACT_PROC (DIFF_NAME_PARM : ONE_TO_FIVE) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : ONE_TO_FIVE);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (ONE_TO_FIVE'FIRST);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                    ("DIFFERENT PARAMETER NAMES MADE MATCH INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- DIFFERENT PARAMETER CONSTRAINTS
----------------------------------------------------------------------

     DECLARE

          PROCEDURE ACT_PROC (PARM : ONE_TO_FIVE) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : ZERO_TO_TEN);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (ONE_TO_FIVE'FIRST);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                    ("DIFFERENT PARAMETER CONSTRAINTS MADE MATCH " &
                     "INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- ONE PARAMETER CONSTRAINED (ARRAY)
----------------------------------------------------------------------

     DECLARE

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

          SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
               ONE_TO_FIVE'LAST);

          PASSED_PARM : ARR_CONST := (OTHERS => TRUE);

          PROCEDURE ACT_PROC (PARM : ARR_CONST) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : ARR_TYPE);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (PASSED_PARM);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                    ("ONE ARRAY PARAMETER CONSTRAINED MADE MATCH " &
                     "INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- ONE PARAMETER CONSTRAINED (RECORDS)
----------------------------------------------------------------------

     DECLARE

          TYPE REC_TYPE (BOL : BOOLEAN) IS
               RECORD
                    SUB_A : INTEGER;
                    CASE BOL IS
                         WHEN TRUE =>
                              DSCR_A : INTEGER;

                         WHEN FALSE =>
                              DSCR_B : BOOLEAN;

                    END CASE;
               END RECORD;

          SUBTYPE REC_CONST IS REC_TYPE (TRUE);

          PASSED_PARM : REC_CONST := (TRUE, 1, 2);

          PROCEDURE ACT_PROC (PARM : REC_CONST) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : REC_TYPE);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (PASSED_PARM);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                    ("ONE RECORD PARAMETER CONSTRAINED MADE MATCH " &
                     "INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- ONE PARAMETER CONSTRAINED (ACCESS)
----------------------------------------------------------------------

     DECLARE

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

          SUBTYPE ARR_CONST     IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
               ONE_TO_FIVE'LAST);

          TYPE ARR_ACC_TYPE IS ACCESS ARR_TYPE;

          SUBTYPE ARR_ACC_CONST IS ARR_ACC_TYPE (1 .. 3);

          PASSED_PARM : ARR_ACC_TYPE := NULL;

          PROCEDURE ACT_PROC (PARM : ARR_ACC_CONST) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : ARR_ACC_TYPE);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (PASSED_PARM);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                    ("ONE ACCESS PARAMETER CONSTRAINED MADE MATCH " &
                     "INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- ONE PARAMETER CONSTRAINED (PRIVATE)
----------------------------------------------------------------------

     DECLARE
          PASSED_PARM : PRI_CONST;

          PROCEDURE ACT_PROC (PARM : PRI_CONST) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : PRI_TYPE);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (PASSED_PARM);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                    ("ONE PRIVATE PARAMETER CONSTRAINED MADE MATCH " &
                     "INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- PRESENCE (OR ABSENCE) OF AN EXPLICIT "IN" MODE
----------------------------------------------------------------------

     DECLARE

          PROCEDURE ACT_PROC (PARM : INTEGER) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM : IN INTEGER);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (1);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED
                     ("PRESENCE OF AN EXPLICIT 'IN' MODE MADE MATCH " &
                     "INVALID");
          END IF;
     END;

----------------------------------------------------------------------
-- DIFFERENT TYPE MARKS
----------------------------------------------------------------------

     DECLARE

          SUBTYPE MARK_1_TYPE IS INTEGER;

          SUBTYPE MARK_2_TYPE IS INTEGER;

          PROCEDURE ACT_PROC (PARM1 : IN MARK_1_TYPE) IS
          BEGIN
               SUBPRG_ACT := TRUE;
          END ACT_PROC;

          GENERIC

               WITH PROCEDURE PASSED_PROC (PARM2 : MARK_2_TYPE);

          PROCEDURE GEN_PROC;

          PROCEDURE GEN_PROC IS
          BEGIN
               PASSED_PROC (1);
          END GEN_PROC;

          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
     BEGIN
          SUBPRG_ACT := FALSE;
          INST_PROC;
          IF NOT SUBPRG_ACT THEN
               FAILED ("DIFFERENT TYPE MARKS MADE MATCH INVALID");
          END IF;
     END;
     RESULT;
END CC3605A;