gcc/testsuite/ada/acats/tests/cb/cb1005a.ada

   1 -- CB1005A.ADA
   2
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 -- CHECK THAT EXCEPTIONS DECLARED IN GENERIC PACKAGES AND PROCEDURES ARE
  26 -- CONSIDERED DISTINCT FOR EACH INSTANTIATION.
  27
  28 -- CHECK THAT AN EXCEPTION NAME DECLARED IN A GENERIC PACKAGE
  29 -- INSTANTIATION IN A RECURSIVE PROCEDURE DENOTES THE SAME ENTITY
  30 -- EVEN WHEN THE INSTANTIATION IS ELABORATED MORE THAN ONCE BECAUSE
  31 -- OF RECURSIVE CALLS.
  32
  33 -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
  34 -- ***       remove incompatibilities associated with the transition   -- 9X
  35 -- ***       to Ada 9X.                                                -- 9X
  36 -- ***                                                                 -- 9X
  37
  38 -- TBN  9/23/86
  39 -- MRM  03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
  40
  41 WITH REPORT; USE REPORT;
  42 PROCEDURE CB1005A IS
  43
  44      PROCEDURE PROP;
  45
  46      GENERIC
  47           PACKAGE PAC IS
  48                EXC : EXCEPTION;
  49           END PAC;
  50
  51      GENERIC
  52           PROCEDURE PROC (INST_AGAIN : BOOLEAN);
  53
  54      PROCEDURE PROC (INST_AGAIN : BOOLEAN) IS
  55           EXC : EXCEPTION;
  56      BEGIN
  57           IF INST_AGAIN THEN
  58                BEGIN
  59                     PROP;
  60                     FAILED ("EXCEPTION WAS NOT PROPAGATED - 9");
  61                EXCEPTION
  62                     WHEN EXC =>
  63                          FAILED ("EXCEPTION NOT DISTINCT - 10");
  64                     WHEN PROGRAM_ERROR | STORAGE_ERROR |
  65                          TASKING_ERROR | CONSTRAINT_ERROR =>
  66                          FAILED ("WRONG EXCEPTION PROPAGATED - 11");
  67                     WHEN OTHERS =>
  68                          NULL;
  69                END;
  70           ELSE
  71                RAISE EXC;
  72           END IF;
  73      END PROC;
  74
  75      PROCEDURE RAISE_EXC (CALL_AGAIN : BOOLEAN) IS
  76           PACKAGE PAC3 IS NEW PAC;
  77      BEGIN
  78           IF CALL_AGAIN THEN
  79                BEGIN
  80                     RAISE_EXC (FALSE);
  81                     FAILED ("EXCEPTION WAS NOT PROPAGATED - 12");
  82                EXCEPTION
  83                     WHEN PAC3.EXC =>
  84                          NULL;
  85                END;
  86           ELSE
  87                RAISE PAC3.EXC;
  88           END IF;
  89      END RAISE_EXC;
  90
  91      PROCEDURE PROP IS
  92           PROCEDURE PROC2 IS NEW PROC;
  93      BEGIN
  94           PROC2 (FALSE);
  95      END PROP;
  96
  97 BEGIN
  98      TEST ("CB1005A", "CHECK THAT EXCEPTIONS DECLARED IN GENERIC " &
  99                       "PACKAGES AND PROCEDURES ARE CONSIDERED " &
 100                       "DISTINCT FOR EACH INSTANTIATION");
 101
 102      -------------------------------------------------------------------
 103      DECLARE
 104           PACKAGE PAC1 IS NEW PAC;
 105           PACKAGE PAC2 IS NEW PAC;
 106           PAC1_EXC_FOUND : BOOLEAN := FALSE;
 107      BEGIN
 108           BEGIN
 109                IF EQUAL (3, 3) THEN
 110                     RAISE PAC2.EXC;
 111                END IF;
 112                FAILED ("EXCEPTION WAS NOT RAISED - 1");
 113
 114           EXCEPTION
 115                WHEN PAC1.EXC =>
 116                     FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 2");
 117                     PAC1_EXC_FOUND := TRUE;
 118           END;
 119           IF NOT PAC1_EXC_FOUND THEN
 120                FAILED ("EXCEPTION WAS NOT PROPAGATED - 3");
 121           END IF;
 122
 123      EXCEPTION
 124           WHEN PAC1.EXC =>
 125                FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 4");
 126           WHEN PAC2.EXC =>
 127                BEGIN
 128                     IF EQUAL (3, 3) THEN
 129                          RAISE PAC1.EXC;
 130                     END IF;
 131                     FAILED ("EXCEPTION WAS NOT RAISED - 5");
 132
 133                EXCEPTION
 134                     WHEN PAC2.EXC =>
 135                          FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 6");
 136                     WHEN PAC1.EXC =>
 137                          NULL;
 138                     WHEN OTHERS =>
 139                          FAILED ("UNKNOWN EXCEPTION RAISED - 7");
 140                END;
 141           WHEN OTHERS =>
 142                FAILED ("UNKNOWN EXCEPTION RAISED - 8");
 143      END;
 144
 145      -------------------------------------------------------------------
 146      DECLARE
 147           PROCEDURE PROC1 IS NEW PROC;
 148      BEGIN
 149           PROC1 (TRUE);
 150      END;
 151
 152      -------------------------------------------------------------------
 153      BEGIN
 154           RAISE_EXC (TRUE);
 155
 156      EXCEPTION
 157           WHEN OTHERS =>
 158                FAILED ("EXCEPTIONS ARE DISTINCT FOR RECURSION - 13");
 159      END;
 160
 161      -------------------------------------------------------------------
 162
 163      RESULT;
 164 END CB1005A;