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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c38202a.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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