1-- C93004F.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
26-- TASK, OTHER TASKS ARE UNAFFECTED.
27
28-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
29
30-- THIS TESTS CHECKS THE CASE IN WHICH THE TASKS ARE CREATED BY THE
31-- ALLOCATION OF A RECORD OF TASKS OR AN ARRAY OF TASKS.
32
33-- R. WILLIAMS 8/7/86
34
35WITH REPORT; USE REPORT;
36
37PROCEDURE C93004F IS
38
39BEGIN
40     TEST ( "C93004F", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
41                       "DURING THE ACTIVATION OF A TASK, OTHER " &
42                       "TASKS ARE UNAFFECTED. IN THIS TEST, THE " &
43                       "TASKS ARE CREATED BY THE ALLOCATION OF A " &
44                       "RECORD OR AN ARRAY OF TASKS" );
45
46     DECLARE
47
48          TASK TYPE T IS
49               ENTRY E;
50          END T;
51
52          TASK TYPE TT;
53
54          TASK TYPE TX IS
55               ENTRY E;
56          END TX;
57
58          TYPE REC IS
59               RECORD
60                    TR : T;
61               END RECORD;
62
63          TYPE ARR IS ARRAY (IDENT_INT (1) .. IDENT_INT (1)) OF T;
64
65          TYPE RECX IS
66               RECORD
67                    TTX1 : TX;
68                    TTT  : TT;
69                    TTX2 : TX;
70               END RECORD;
71
72          TYPE ACCR IS ACCESS REC;
73          AR : ACCR;
74
75          TYPE ACCA IS ACCESS ARR;
76          AA : ACCA;
77
78          TYPE ACCX IS ACCESS RECX;
79          AX : ACCX;
80
81          TASK BODY T IS
82          BEGIN
83               ACCEPT E;
84          END T;
85
86          TASK BODY TT IS
87          BEGIN
88               AR.TR.E;
89          EXCEPTION
90               WHEN OTHERS =>
91                    FAILED ( "TASK AR.TR NOT ACTIVE" );
92          END TT;
93
94          TASK BODY TX IS
95               I : POSITIVE := IDENT_INT (0); -- RAISE
96                                              -- CONSTRAINT_ERROR.
97          BEGIN
98               IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
99                    FAILED ( "TX ACTIVATED OK" );
100               END IF;
101          END TX;
102
103     BEGIN
104          AR := NEW REC;
105          AA := NEW ARR;
106          AX := NEW RECX;
107
108          FAILED ( "TASKING_ERROR NOT RAISED IN MAIN" );
109
110          AA.ALL (1).E;        -- CLEAN UP.
111
112     EXCEPTION
113          WHEN TASKING_ERROR =>
114
115               BEGIN
116                    AA.ALL (1).E;
117               EXCEPTION
118                    WHEN TASKING_ERROR =>
119                         FAILED ( "AA.ALL (1) NOT ACTIVATED" );
120               END;
121
122          WHEN CONSTRAINT_ERROR =>
123               FAILED ( "CONSTRAINT_ERROR RAISED IN MAIN" );
124          WHEN OTHERS =>
125               FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
126     END;
127
128     RESULT;
129
130END C93004F;
131