1-- C95022B.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 IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE
26-- THE BODY OF AN ACCEPT STATEMENT.
27
28-- CHECK THE CASE OF ABORT DURING THE INNERMOST ACCEPT.
29
30-- JEAN-PIERRE ROSEN 25-FEB-1984
31-- JBG 6/1/84
32
33WITH REPORT; USE REPORT;
34PROCEDURE C95022B IS
35
36BEGIN
37
38     TEST("C95022B", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
39                     "CORRECTLY (ABORT CASE)");
40     DECLARE
41          TASK TYPE CLIENT IS
42               ENTRY GET_ID (I : INTEGER);
43          END CLIENT;
44
45          T_ARR : ARRAY (1..4) OF CLIENT;
46
47          TASK KILL IS
48               ENTRY ME;
49          END KILL;
50
51          TASK SERVER IS
52               ENTRY E1;
53               ENTRY E2;
54               ENTRY E3;
55               ENTRY E4;
56          END SERVER;
57
58          TASK BODY SERVER IS
59          BEGIN
60
61               ACCEPT E1 DO
62                    ACCEPT E2 DO
63                         ACCEPT E3 DO
64                              ACCEPT E4 DO
65                                   KILL.ME;
66                                   E1;  -- WILL DEADLOCK UNTIL ABORT.
67                              END E4;
68                         END E3;
69                    END E2;
70               END E1;
71
72          END SERVER;
73
74          TASK BODY KILL IS
75          BEGIN
76               ACCEPT ME;
77               ABORT SERVER;
78          END;
79
80          TASK BODY CLIENT IS
81               ID : INTEGER;
82          BEGIN
83               ACCEPT GET_ID( I : INTEGER) DO
84                    ID := I;
85               END GET_ID;
86
87               CASE ID IS
88                    WHEN 1      => SERVER.E1;
89                    WHEN 2      => SERVER.E2;
90                    WHEN 3      => SERVER.E3;
91                    WHEN 4      => SERVER.E4;
92                    WHEN OTHERS => FAILED ("INCORRECT ID");
93               END CASE;
94
95               FAILED ("TASKING_ERROR NOT RAISED IN CLIENT" &
96                       INTEGER'IMAGE(ID));
97
98          EXCEPTION
99               WHEN TASKING_ERROR =>
100                    NULL;
101               WHEN OTHERS =>
102                    FAILED("EXCEPTION IN CLIENT" & INTEGER'IMAGE(ID));
103          END CLIENT;
104     BEGIN
105          FOR I IN 1 .. 4 LOOP
106               T_ARR(I).GET_ID(I);
107          END LOOP;
108     END;
109
110     RESULT;
111
112END C95022B;
113