1-- CB5002A.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-- OBJECTIVE:
26--     CHECK THAT WHEN "TASKING_ERROR" IS RAISED EXPLICITLY OR BY
27--     PROPAGATION WITHIN AN ACCEPT STATEMENT, THEN "TASKING_ERROR"
28--     IS RAISED IN BOTH THE CALLING AND THE CALLED TASK.
29
30-- HISTORY:
31--     DHH 03/31/88 CREATED ORIGINAL TEST.
32
33WITH REPORT; USE REPORT;
34PROCEDURE CB5002A IS
35
36BEGIN
37     TEST("CB5002A", "CHECK THAT WHEN ""TASKING_ERROR"" IS RAISED " &
38                     "EXPLICITLY OR BY PROPAGATION WITHIN AN ACCEPT " &
39                     "STATEMENT, THEN ""TASKING_ERROR"" IS RAISED " &
40                     "IN BOTH THE CALLING AND THE CALLED TASK");
41
42     DECLARE
43          TASK CALLING_EXP IS
44               ENTRY A;
45          END CALLING_EXP;
46
47          TASK CALLED_EXP IS
48               ENTRY B;
49               ENTRY STOP;
50          END CALLED_EXP;
51
52          TASK CALLING_PROP IS
53               ENTRY C;
54          END CALLING_PROP;
55
56          TASK CALLED_PROP IS
57               ENTRY D;
58               ENTRY STOP;
59          END CALLED_PROP;
60
61          TASK PROP IS
62               ENTRY E;
63               ENTRY STOP;
64          END PROP;
65-----------------------------------------------------------------------
66          TASK BODY CALLING_EXP IS
67          BEGIN
68               ACCEPT A DO
69                    BEGIN
70                         CALLED_EXP.B;
71                         FAILED("EXCEPTION NOT RAISED IN CALLING " &
72                                "TASK - EXPLICIT RAISE");
73                    EXCEPTION
74                         WHEN TASKING_ERROR =>
75                              NULL;
76                         WHEN OTHERS =>
77                              FAILED("WRONG EXCEPTION RAISED IN " &
78                                     "CALLING TASK - EXPLICIT RAISE");
79                    END; -- EXCEPTION
80               END A;
81          END CALLING_EXP;
82
83          TASK BODY CALLED_EXP IS
84          BEGIN
85               BEGIN
86                    ACCEPT B DO
87                         RAISE TASKING_ERROR;
88                         FAILED("EXCEPTION NOT RAISED IN CALLED " &
89                                "TASK - EXPLICIT RAISE");
90                    END B;
91               EXCEPTION
92                    WHEN TASKING_ERROR =>
93                         NULL;
94                    WHEN OTHERS =>
95                         FAILED("WRONG EXCEPTION RAISED IN CALLED " &
96                                "TASK - EXPLICIT RAISE");
97               END;  -- EXCEPTION BLOCK
98
99               ACCEPT STOP;
100          END CALLED_EXP;
101
102-----------------------------------------------------------------------
103          TASK BODY CALLING_PROP IS
104          BEGIN
105               ACCEPT C DO
106                    BEGIN
107                         CALLED_PROP.D;
108                         FAILED("EXCEPTION NOT RAISED IN CALLING " &
109                                "TASK - PROPAGATED RAISE");
110                    EXCEPTION
111                         WHEN TASKING_ERROR =>
112                              NULL;
113                         WHEN OTHERS =>
114                              FAILED("WRONG EXCEPTION RAISED IN " &
115                                     "CALLING TASK - PROPAGATED RAISE");
116                    END;  -- EXCEPTION
117               END C;
118          END CALLING_PROP;
119
120          TASK BODY CALLED_PROP IS
121          BEGIN
122               BEGIN
123                    ACCEPT D DO
124                         PROP.E;
125                         FAILED("EXCEPTION NOT RAISED IN CALLED " &
126                                "TASK - PROPAGATED RAISE");
127                    END D;
128               EXCEPTION
129                    WHEN TASKING_ERROR =>
130                         NULL;
131                    WHEN OTHERS =>
132                         FAILED("WRONG EXCEPTION RAISED IN CALLED " &
133                                "TASK - PROPAGATED RAISE");
134               END;  -- EXCEPTION BLOCK;
135
136               ACCEPT STOP;
137          END CALLED_PROP;
138
139          TASK BODY PROP IS
140          BEGIN
141               BEGIN
142                    ACCEPT E DO
143                         RAISE TASKING_ERROR;
144                         FAILED("EXCEPTION NOT RAISED IN PROPAGATE " &
145                                "TASK - ACCEPT E");
146                    END E;
147               EXCEPTION
148                    WHEN TASKING_ERROR =>
149                         NULL;
150                    WHEN OTHERS =>
151                         FAILED("WRONG EXCEPTION RAISED IN PROP. TASK");
152              END;    -- EXCEPTION BLOCK
153
154              ACCEPT STOP;
155
156          END PROP;
157-----------------------------------------------------------------------
158     BEGIN
159          CALLING_EXP.A;
160          CALLING_PROP.C;
161          CALLED_EXP.STOP;
162          CALLED_PROP.STOP;
163          PROP.STOP;
164
165     END;    -- DECLARE
166
167     RESULT;
168END CB5002A;
169