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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C94011A.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 IF A FORMAL ACCESS TYPE OF A GENERIC UNIT DESIGNATES A
26 
-- FORMAL LIMITED PRIVATE TYPE, THEN WHEN THE UNIT IS INSTANTIATED WITH
27 
-- A TASK TYPE OR A TYPE HAVING A SUBCOMPONENT OF A TASK TYPE, THE
28 
-- MASTER FOR ANY TASKS ALLOCATED WITHIN THE INSTANTIATED UNIT IS
29 
-- DETERMINED BY THE ACTUAL PARAMETER.
30 
 
31 
-- TBN  9/22/86
32 
 
33 
WITH REPORT; USE REPORT;
34 
PROCEDURE C94011A IS
35 
 
36 
     GLOBAL_INT : INTEGER := 0;
37 
     MY_EXCEPTION : EXCEPTION;
38 
 
39 
     PACKAGE P IS
40 
          TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
41 
          PROCEDURE E (T : LIM_PRI_TASK);
42 
     PRIVATE
43 
          TASK TYPE LIM_PRI_TASK IS
44 
               ENTRY E;
45 
          END LIM_PRI_TASK;
46 
     END P;
47 
 
48 
     USE P;
49 
 
50 
     TASK TYPE TT IS
51 
          ENTRY E;
52 
     END TT;
53 
 
54 
     TYPE REC IS
55 
          RECORD
56 
               A : INTEGER := 1;
57 
               B : TT;
58 
          END RECORD;
59 
 
60 
     TYPE LIM_REC IS
61 
          RECORD
62 
               A : INTEGER := 1;
63 
               B : LIM_PRI_TASK;
64 
          END RECORD;
65 
 
66 
     PACKAGE BODY P IS
67 
          TASK BODY LIM_PRI_TASK IS
68 
          BEGIN
69 
               ACCEPT E;
70 
               GLOBAL_INT := IDENT_INT (2);
71 
          END LIM_PRI_TASK;
72 
 
73 
          PROCEDURE E (T : LIM_PRI_TASK) IS
74 
          BEGIN
75 
               T.E;
76 
          END E;
77 
     END P;
78 
 
79 
     TASK BODY TT IS
80 
     BEGIN
81 
          ACCEPT E;
82 
          GLOBAL_INT := IDENT_INT (1);
83 
     END TT;
84 
 
85 
     GENERIC
86 
          TYPE T IS LIMITED PRIVATE;
87 
          TYPE ACC_T IS ACCESS T;
88 
     PROCEDURE PROC (A : OUT ACC_T);
89 
 
90 
     PROCEDURE PROC (A : OUT ACC_T) IS
91 
     BEGIN
92 
          A := NEW T;
93 
     END PROC;
94 
 
95 
     GENERIC
96 
          TYPE T IS LIMITED PRIVATE;
97 
          TYPE ACC_T IS ACCESS T;
98 
     FUNCTION FUNC RETURN ACC_T;
99 
 
100 
     FUNCTION FUNC RETURN ACC_T IS
101 
     BEGIN
102 
          RETURN NEW T;
103 
     END FUNC;
104 
 
105 
     GENERIC
106 
          TYPE T IS LIMITED PRIVATE;
107 
          TYPE ACC_T IS ACCESS T;
108 
     PACKAGE PAC IS
109 
          PTR_T : ACC_T := NEW T;
110 
     END PAC;
111 
 
112 
BEGIN
113 
     TEST ("C94011A", "CHECK THAT IF A FORMAL ACCESS TYPE OF A " &
114 
                      "GENERIC UNIT DESIGNATES A FORMAL LIMITED " &
115 
                      "PRIVATE TYPE, THEN WHEN THE UNIT IS " &
116 
                      "INSTANTIATED, THE MASTER FOR ANY TASKS " &
117 
                      "ALLOCATED WITHIN THE INSTANTIATED UNIT IS " &
118 
                      "DETERMINED BY THE ACTUAL PARAMETER");
119 
 
120 
     -------------------------------------------------------------------
121 
     DECLARE
122 
          TYPE ACC_TT IS ACCESS TT;
123 
          ACC1 : ACC_TT;
124 
          PROCEDURE PROC1 IS NEW PROC (TT, ACC_TT);
125 
     BEGIN
126 
          PROC1 (ACC1);
127 
          ACC1.E;
128 
     EXCEPTION
129 
          WHEN OTHERS =>
130 
               FAILED ("TASK DEPENDENT ON WRONG MASTER - 1");
131 
     END;
132 
     IF GLOBAL_INT = IDENT_INT (0) THEN
133 
          FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
134 
     END IF;
135 
 
136 
     -------------------------------------------------------------------
137 
     BEGIN
138 
          GLOBAL_INT := IDENT_INT (0);
139 
          DECLARE
140 
               TYPE ACC_REC IS ACCESS REC;
141 
               A : ACC_REC;
142 
               FUNCTION FUNC1 IS NEW FUNC (REC, ACC_REC);
143 
          BEGIN
144 
               A := FUNC1;
145 
               A.B.E;
146 
               RAISE MY_EXCEPTION;
147 
          EXCEPTION
148 
               WHEN MY_EXCEPTION =>
149 
                    RAISE MY_EXCEPTION;
150 
               WHEN OTHERS =>
151 
                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 2");
152 
          END;
153 
          FAILED ("MY_EXCEPTION NOT RAISED - 2");
154 
     EXCEPTION
155 
          WHEN MY_EXCEPTION =>
156 
               IF GLOBAL_INT = IDENT_INT (0) THEN
157 
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
158 
               END IF;
159 
          WHEN OTHERS =>
160 
               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
161 
     END;
162 
 
163 
     -------------------------------------------------------------------
164 
     GLOBAL_INT := IDENT_INT (0);
165 
 
166 
     BEGIN
167 
          DECLARE
168 
               TYPE ACC_LIM_TT IS ACCESS LIM_PRI_TASK;
169 
          BEGIN
170 
               DECLARE
171 
                    A : ACC_LIM_TT;
172 
                    FUNCTION FUNC2 IS NEW FUNC (LIM_PRI_TASK,
173 
                                                            ACC_LIM_TT);
174 
               BEGIN
175 
                    A := FUNC2;
176 
                    E (A.ALL);
177 
               END;
178 
          EXCEPTION
179 
               WHEN OTHERS =>
180 
                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 3");
181 
          END;
182 
          IF GLOBAL_INT = IDENT_INT (0) THEN
183 
               FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
184 
          END IF;
185 
     END;
186 
 
187 
     -------------------------------------------------------------------
188 
     GLOBAL_INT := IDENT_INT (0);
189 
 
190 
     BEGIN
191 
          DECLARE
192 
               TYPE ACC_LIM_REC IS ACCESS LIM_REC;
193 
          BEGIN
194 
               DECLARE
195 
                    ACC2 : ACC_LIM_REC;
196 
                    PROCEDURE PROC2 IS NEW PROC (LIM_REC, ACC_LIM_REC);
197 
               BEGIN
198 
                    PROC2 (ACC2);
199 
                    E (ACC2.B);
200 
               END;
201 
               RAISE MY_EXCEPTION;
202 
          EXCEPTION
203 
               WHEN MY_EXCEPTION =>
204 
                    RAISE MY_EXCEPTION;
205 
               WHEN OTHERS =>
206 
                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 4");
207 
          END;
208 
          FAILED ("MY_EXCEPTION NOT RAISED - 4");
209 
     EXCEPTION
210 
          WHEN MY_EXCEPTION =>
211 
               IF GLOBAL_INT = IDENT_INT (0) THEN
212 
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
213 
               END IF;
214 
          WHEN OTHERS =>
215 
               FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
216 
     END;
217 
 
218 
     -------------------------------------------------------------------
219 
     BEGIN
220 
           GLOBAL_INT := IDENT_INT (0);
221 
 
222 
          DECLARE
223 
               TYPE ACC_TT IS ACCESS TT;
224 
               PACKAGE PAC1 IS NEW PAC (TT, ACC_TT);
225 
               USE PAC1;
226 
          BEGIN
227 
               PTR_T.E;
228 
               RAISE MY_EXCEPTION;
229 
          EXCEPTION
230 
               WHEN MY_EXCEPTION =>
231 
                    RAISE MY_EXCEPTION;
232 
               WHEN OTHERS =>
233 
                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 5");
234 
          END;
235 
          FAILED ("MY_EXCEPTION NOT RAISED - 5");
236 
     EXCEPTION
237 
          WHEN MY_EXCEPTION =>
238 
               IF GLOBAL_INT = IDENT_INT (0) THEN
239 
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
240 
               END IF;
241 
          WHEN OTHERS =>
242 
               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
243 
     END;
244 
 
245 
     -------------------------------------------------------------------
246 
     GLOBAL_INT := IDENT_INT (0);
247 
 
248 
     DECLARE
249 
          TYPE ACC_LIM_REC IS ACCESS LIM_REC;
250 
     BEGIN
251 
          DECLARE
252 
               PACKAGE PAC2 IS NEW PAC (LIM_REC, ACC_LIM_REC);
253 
               USE PAC2;
254 
          BEGIN
255 
               E (PTR_T.B);
256 
          END;
257 
     EXCEPTION
258 
          WHEN OTHERS =>
259 
               FAILED ("TASK DEPENDENT ON WRONG MASTER - 6");
260 
     END;
261 
     IF GLOBAL_INT = IDENT_INT (0) THEN
262 
          FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
263 
     END IF;
264 
 
265 
     -------------------------------------------------------------------
266 
 
267 
     RESULT;
268 
END C94011A;

powered by: WebSVN 2.1.0

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