Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c94006a.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C94006A.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 A DECLARATION THAT RENAMES A TASK DOES NOT CREATE A NEW
26 -- MASTER FOR THE TASK.
27
28 -- TBN 9/17/86
29 -- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
30
31 with Impdef;
32 WITH REPORT; USE REPORT;
33 WITH SYSTEM; USE SYSTEM;
34 PROCEDURE C94006A IS
35
36 TASK TYPE TT IS
37 ENTRY E;
38 END TT;
39
40 TASK BODY TT IS
41 BEGIN
42 SELECT
43 ACCEPT E;
44 OR
45 DELAY 30.0 * Impdef.One_Long_Second;
46 END SELECT;
47 END TT;
48
49
50 BEGIN
51 TEST ("C94006A", "CHECK THAT A DECLARATION THAT RENAMES A TASK " &
52 "DOES NOT CREATE A NEW MASTER FOR THE TASK");
53
54 -------------------------------------------------------------------
55 DECLARE
56 T1 : TT;
57 BEGIN
58 DECLARE
59 RENAME_TASK : TT RENAMES T1;
60 BEGIN
61 NULL;
62 END;
63 IF T1'TERMINATED THEN
64 FAILED ("TASK DEPENDENT ON WRONG UNIT - 1");
65 ELSE
66 T1.E;
67 END IF;
68 END;
69
70 -------------------------------------------------------------------
71
72 DECLARE
73 T2 : TT;
74
75 PACKAGE P IS
76 Q : TT RENAMES T2;
77 END P;
78
79 PACKAGE BODY P IS
80 BEGIN
81 NULL;
82 END P;
83
84 USE P;
85 BEGIN
86 IF Q'TERMINATED THEN
87 FAILED ("TASK DEPENDENT ON WRONG UNIT - 2");
88 ELSE
89 Q.E;
90 END IF;
91 END;
92
93 -------------------------------------------------------------------
94
95 DECLARE
96 TYPE ACC_TT IS ACCESS TT;
97 P1 : ACC_TT;
98 BEGIN
99 DECLARE
100 RENAME_ACCESS : ACC_TT RENAMES P1;
101 BEGIN
102 RENAME_ACCESS := NEW TT;
103 END;
104 IF P1'TERMINATED THEN
105 FAILED ("TASK DEPENDENT ON WRONG UNIT - 3");
106 ELSE
107 P1.E;
108 END IF;
109 END;
110
111 -------------------------------------------------------------------
112
113 DECLARE
114 TYPE ACC_TT IS ACCESS TT;
115 P2 : ACC_TT;
116
117 PACKAGE Q IS
118 RENAME_ACCESS : ACC_TT RENAMES P2;
119 END Q;
120
121 PACKAGE BODY Q IS
122 BEGIN
123 RENAME_ACCESS := NEW TT;
124 END Q;
125
126 USE Q;
127 BEGIN
128 IF RENAME_ACCESS'TERMINATED THEN
129 FAILED ("TASK DEPENDENT ON WRONG UNIT - 4");
130 ELSE
131 RENAME_ACCESS.E;
132 END IF;
133 END;
134
135 RESULT;
136 END C94006A;