1-- CB4004A.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 VARIOUS EXCEPTIONS IN THE BODY OF A SUBPROGRAM WITH
26-- AN APPLICABLE HANDLER ARE HANDLED LOCALLY.
27
28-- DAT 04/15/81
29-- JRK 04/24/81
30-- SPS 11/02/82
31-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
32
33WITH REPORT; USE REPORT;
34
35PROCEDURE CB4004A IS
36
37     E, F : EXCEPTION;
38     STORAGE_ERROR: EXCEPTION;
39
40     I1 : INTEGER RANGE 1 .. 1;
41
42     FUNCTION F1 (I : INTEGER) RETURN BOOLEAN IS
43     BEGIN
44          CASE I IS
45               WHEN 1 => RAISE E;
46               WHEN 2 => RAISE STORAGE_ERROR;
47               WHEN 3 => I1 := 4;
48               WHEN 4 => RAISE TASKING_ERROR;
49               WHEN OTHERS => NULL;
50          END CASE;
51          RETURN FALSE;
52     EXCEPTION
53          WHEN E | F => RETURN I = 1;
54          WHEN STORAGE_ERROR => RETURN I = 2;
55          WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
56               RETURN I = 3;
57          WHEN OTHERS => RETURN I = 4;
58     END F1;
59
60BEGIN
61     TEST ("CB4004A", "EXCEPTIONS WITH LOCAL HANDLERS ARE HANDLED"
62          & " THERE");
63
64     BEGIN
65          FOR L IN 1 .. 4 LOOP
66               IF F1(L) /= TRUE THEN
67                    FAILED ("LOCAL EXCEPTIONS DON'T WORK");
68                    EXIT;
69               END IF;
70          END LOOP;
71     EXCEPTION
72          WHEN OTHERS =>
73               FAILED ("WRONG HANDLER");
74     END;
75
76     RESULT;
77END CB4004A;
78