OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c94006a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.