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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C38202A.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 TASKING ATTRIBUTES ARE DECLARED AND RETURN CORRECT
26 
-- VALUES FOR OBJECTS HAVING AN ACCESS TYPE WHOSE DESIGNATED
27 
-- TYPE IS A TASK TYPE.
28 
-- CHECK THE ACCESS TYPE RESULTS OF FUNCTION CALLS.
29 
 
30 
-- AH  9/12/86
31 
-- EDS 7/14/98  AVOID OPTIMIZATION
32 
 
33 
with Impdef;
34 
WITH REPORT; USE REPORT;
35 
PROCEDURE C38202A IS
36 
BEGIN
37 
     TEST ("C38202A", "OBJECTS HAVING ACCESS TYPES WITH DESIGNATED " &
38 
           "TASK TYPE CAN BE PREFIX OF TASKING ATTRIBUTES");
39 
 
40 
-- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
41 
--                   (2)  TASK IS NOT CALLABLE, TERMINATED.
42 
 
43 
     DECLARE
44 
          TASK TYPE TSK IS
45 
               ENTRY GO_ON;
46 
          END TSK;
47 
 
48 
          TASK DRIVER IS
49 
               ENTRY TSK_DONE;
50 
          END DRIVER;
51 
 
52 
          TYPE P_TYPE IS ACCESS TSK;
53 
          P : P_TYPE;
54 
 
55 
          TASK BODY TSK IS
56 
               I : INTEGER RANGE 0 .. 2;
57 
          BEGIN
58 
               ACCEPT GO_ON;
59 
               I := IDENT_INT(5);         -- CONSTRAINT_ERROR RAISED.
60 
               FAILED ("CONSTAINT_ERROR NOT RAISED IN TASK " &
61 
                       " TSK - 1A " & INTEGER'IMAGE(I));
62 
          EXCEPTION
63 
               WHEN CONSTRAINT_ERROR =>
64 
                    DRIVER.TSK_DONE;
65 
               WHEN OTHERS =>
66 
                    FAILED ("WRONG EXCEPTION RAISED IN TASK " &
67 
                            "TSK - 1A ");
68 
                    DRIVER.TSK_DONE;
69 
          END TSK;
70 
 
71 
          TASK BODY DRIVER IS
72 
               COUNTER : INTEGER := 1;
73 
          BEGIN
74 
               P := NEW TSK;
75 
               IF NOT P'CALLABLE THEN
76 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
77 
                            "VALUE - 1B");
78 
               END IF;
79 
 
80 
               IF P'TERMINATED THEN
81 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
82 
                            "VALUE - 1C");
83 
               END IF;
84 
 
85 
               P.GO_ON;
86 
               ACCEPT TSK_DONE;
87 
               WHILE (NOT P'TERMINATED AND COUNTER <= 3) LOOP
88 
                    DELAY 10.0 * Impdef.One_Second;
89 
                    COUNTER := COUNTER + 1;
90 
               END LOOP;
91 
 
92 
               IF COUNTER > 3 THEN
93 
                    FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
94 
                            "TIME - 1D");
95 
               END IF;
96 
 
97 
               IF P'CALLABLE THEN
98 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
99 
                            "VALUE - 1E");
100 
               END IF;
101 
 
102 
               IF NOT P'TERMINATED THEN
103 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
104 
                            "VALUE - 1F");
105 
               END IF;
106 
          END DRIVER;
107 
 
108 
     BEGIN
109 
          NULL;
110 
     END;     -- BLOCK
111 
 
112 
-- CHECK ACCESS TYPE RESULT RETURNED FROM FUNCTION.
113 
-- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
114 
--                   (2)  TASK IS NOT CALLABLE, TERMINATED.
115 
 
116 
     DECLARE
117 
          TASK TYPE TSK IS
118 
               ENTRY GO_ON;
119 
          END TSK;
120 
 
121 
          TASK DRIVER IS
122 
               ENTRY TSK_DONE;
123 
          END DRIVER;
124 
 
125 
          TYPE P_TYPE IS ACCESS TSK;
126 
          P : P_TYPE;
127 
 
128 
          TSK_CREATED : BOOLEAN := FALSE;
129 
 
130 
          FUNCTION F1 RETURN P_TYPE IS
131 
          BEGIN
132 
               RETURN P;
133 
          END F1;
134 
 
135 
          TASK BODY TSK IS
136 
               I : INTEGER RANGE 0 .. 2;
137 
          BEGIN
138 
               ACCEPT GO_ON;
139 
               I := IDENT_INT(5);          -- CONSTRAINT_ERROR RAISED.
140 
               FAILED ("CONSTRAINT_ERROR NOT RAISED IN TASK " &
141 
                       "TSK - 2A " & INTEGER'IMAGE(I));
142 
          EXCEPTION
143 
               WHEN CONSTRAINT_ERROR =>
144 
                    DRIVER.TSK_DONE;
145 
               WHEN OTHERS =>
146 
                    FAILED ("WRONG EXCEPTION RAISED IN TASK " &
147 
                            "TSK - 2A ");
148 
                    DRIVER.TSK_DONE;
149 
          END TSK;
150 
 
151 
          TASK BODY DRIVER IS
152 
               COUNTER : INTEGER := 1;
153 
          BEGIN
154 
               P := NEW TSK;               -- ACTIVATE P.ALL (F1.ALL).
155 
               IF NOT F1'CALLABLE THEN
156 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
157 
                            "VALUE WHEN PREFIX IS VALUE FROM " &
158 
                            "FUNCTION CALL - 2B");
159 
               END IF;
160 
 
161 
               IF F1'TERMINATED THEN
162 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
163 
                            "VALUE WHEN PREFIX IS VALUE FROM " &
164 
                            "FUNCTION CALL - 2C");
165 
               END IF;
166 
 
167 
               F1.ALL.GO_ON;
168 
               ACCEPT TSK_DONE;
169 
               WHILE (NOT F1'TERMINATED AND COUNTER <= 3) LOOP
170 
                    DELAY 10.0 * Impdef.One_Second;
171 
                    COUNTER := COUNTER + 1;
172 
               END LOOP;
173 
 
174 
               IF COUNTER > 3 THEN
175 
                    FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
176 
                            "TIME - 2D");
177 
               END IF;
178 
 
179 
               IF F1'CALLABLE THEN
180 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
181 
                            "VALUE WHEN PREFIX IS VALUE FROM " &
182 
                            "FUNCTION CALL - 2E");
183 
               END IF;
184 
 
185 
               IF NOT F1'TERMINATED THEN
186 
                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
187 
                            "VALUE WHEN PREFIX IS VALUE FROM " &
188 
                            "FUNCTION CALL - 2F");
189 
               END IF;
190 
          END DRIVER;
191 
 
192 
     BEGIN
193 
          NULL;
194 
     END;     -- BLOCK
195 
 
196 
     RESULT;
197 
END C38202A;

powered by: WebSVN 2.1.0

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