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

   1 -- CB3003A.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 THE NON-SPECIFIC RAISE STATEMENT PROPAGATES THE EXCEPTION
  26 --    FOR FURTHER PROCESSING(HANDLING) IN ANOTHER HANDLER.
  27
  28 -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
  29 -- ***       remove incompatibilities associated with the transition   -- 9X
  30 -- ***       to Ada 9X.                                                -- 9X
  31 -- ***                                                                 -- 9X
  32
  33 -- DCB 04/01/80
  34 -- JRK 11/19/80
  35 -- SPS 11/2/82
  36 -- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
  37
  38 WITH REPORT;
  39 PROCEDURE CB3003A IS
  40
  41      USE REPORT;
  42
  43      FLOW_COUNT : INTEGER := 0;
  44      E1,E2 : EXCEPTION;
  45
  46 BEGIN
  47      TEST("CB3003A","CHECK THAT THE NON-SPECIFIC RAISE STATEMENT" &
  48           " PROPAGATES THE ERROR FOR FURTHER HANDLING IN ANOTHER" &
  49           " HANDLER");
  50
  51      -------------------------------------------------------
  52
  53      BEGIN
  54           BEGIN
  55                BEGIN
  56                     FLOW_COUNT := FLOW_COUNT + 1;
  57                     RAISE E1;
  58                     FAILED("EXCEPTION NOT RAISED (CASE 1)");
  59                EXCEPTION
  60                     WHEN OTHERS =>
  61                          FLOW_COUNT := FLOW_COUNT + 1;
  62                          RAISE;
  63                          FAILED("EXCEPTION NOT RERAISED (CASE 1; " &
  64                                 "INNER)");
  65                END;
  66
  67           EXCEPTION
  68           -- A HANDLER SPECIFIC TO THE RAISED EXCEPTION (E1).
  69                WHEN E1 =>
  70                     FLOW_COUNT := FLOW_COUNT + 1;
  71                     RAISE;
  72                     FAILED("EXCEPTION NOT RERAISED (CASE 1; OUTER)");
  73                WHEN OTHERS =>
  74                     FAILED("WRONG EXCEPTION RAISED (CASE 1)");
  75           END;
  76
  77      EXCEPTION
  78           WHEN E1 =>
  79                FLOW_COUNT := FLOW_COUNT + 1;
  80           WHEN OTHERS =>
  81                FAILED("WRONG EXCEPTION PASSED (CASE 1)");
  82      END;
  83
  84      -------------------------------------------------------
  85
  86      BEGIN
  87           BEGIN
  88                BEGIN
  89                     FLOW_COUNT := FLOW_COUNT + 1;
  90                     RAISE E1;
  91                     FAILED("EXCEPTION NOT RAISED (CASE 2)");
  92                EXCEPTION
  93                     WHEN OTHERS =>
  94                          FLOW_COUNT := FLOW_COUNT + 1;
  95                          RAISE;
  96                          FAILED("EXCEPTION NOT RERAISED (CASE 2; " &
  97                                 "INNER)");
  98                END;
  99
 100           EXCEPTION
 101           -- A HANDLER FOR SEVERAL EXCEPTIONS INCLUDING THE ONE RAISED.
 102                WHEN CONSTRAINT_ERROR =>
 103                     FAILED("WRONG EXCEPTION RAISED (CONSTRAINT_ERROR)");
 104                WHEN E2 =>
 105                     FAILED("WRONG EXCEPTION RAISED (E2)");
 106                WHEN PROGRAM_ERROR | E1 | TASKING_ERROR =>
 107                     FLOW_COUNT := FLOW_COUNT + 1;
 108                     RAISE;
 109                     FAILED("EXCEPTION NOT RERAISED (CASE 2; OUTER)");
 110                WHEN STORAGE_ERROR =>
 111                     FAILED("WRONG EXCEPTION RAISED (STORAGE_ERROR)");
 112                WHEN OTHERS =>
 113                     FAILED("WRONG EXCEPTION RAISED (OTHERS)");
 114           END;
 115
 116      EXCEPTION
 117           WHEN E1 =>
 118                FLOW_COUNT := FLOW_COUNT + 1;
 119           WHEN OTHERS =>
 120                FAILED("WRONG EXCEPTION PASSED (CASE 2)");
 121      END;
 122
 123      -------------------------------------------------------
 124
 125      BEGIN
 126           BEGIN
 127                BEGIN
 128                     FLOW_COUNT := FLOW_COUNT + 1;
 129                     RAISE E1;
 130                     FAILED("EXCEPTION NOT RAISED (CASE 3)");
 131                EXCEPTION
 132                     WHEN OTHERS =>
 133                          FLOW_COUNT := FLOW_COUNT + 1;
 134                          RAISE;
 135                          FAILED("EXCEPTION NOT RERAISED (CASE 3; " &
 136                                 "INNER)");
 137                END;
 138
 139           EXCEPTION
 140           -- A NON-SPECIFIC HANDLER.
 141                WHEN CONSTRAINT_ERROR | E2 =>
 142                     FAILED("WRONG EXCEPTION RAISED " &
 143                            "(CONSTRAINT_ERROR | E2)");
 144                WHEN OTHERS =>
 145                     FLOW_COUNT := FLOW_COUNT + 1;
 146                     RAISE;
 147                     FAILED("EXCEPTION NOT RERAISED (CASE 3; OUTER)");
 148           END;
 149
 150      EXCEPTION
 151           WHEN E1 =>
 152                FLOW_COUNT := FLOW_COUNT + 1;
 153           WHEN OTHERS =>
 154                FAILED("WRONG EXCEPTION PASSED (CASE 3)");
 155      END;
 156
 157      -------------------------------------------------------
 158
 159      IF FLOW_COUNT /= 12 THEN
 160           FAILED("INCORRECT FLOW_COUNT VALUE");
 161      END IF;
 162
 163      RESULT;
 164 END CB3003A;