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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C34008A.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 
-- OBJECTIVE:
26 
--     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
27 
--     (IMPLICITLY) FOR DERIVED TASK TYPES.
28 
 
29 
-- HISTORY:
30 
--     JRK 08/27/87  CREATED ORIGINAL TEST.
31 
--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
32 
--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
33 
--     DTN 11/30/95  REMOVED ATTIBUTES OF NON-OBJECTS.
34 
 
35 
WITH SYSTEM; USE SYSTEM;
36 
WITH REPORT; USE REPORT;
37 
 
38 
PROCEDURE C34008A IS
39 
 
40 
     PACKAGE PKG IS
41 
 
42 
          TASK TYPE PARENT IS
43 
               ENTRY E (I : IN OUT INTEGER);
44 
               ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
45 
               ENTRY G;
46 
               ENTRY H (1 .. 3);
47 
               ENTRY R (I : OUT INTEGER);
48 
               ENTRY W (I : INTEGER);
49 
          END PARENT;
50 
 
51 
          FUNCTION ID (X : PARENT) RETURN INTEGER;
52 
 
53 
     END PKG;
54 
 
55 
     USE PKG;
56 
 
57 
     TYPE T IS NEW PARENT;
58 
 
59 
     TASK TYPE AUX;
60 
 
61 
     X : T;
62 
     W : PARENT;
63 
     B : BOOLEAN := FALSE;
64 
     I : INTEGER := 0;
65 
     J : INTEGER := 0;
66 
     A1, A2 : AUX;
67 
 
68 
     PROCEDURE A (X : ADDRESS) IS
69 
     BEGIN
70 
          B := IDENT_BOOL (TRUE);
71 
     END A;
72 
 
73 
     FUNCTION V RETURN T IS
74 
     BEGIN
75 
          RETURN X;
76 
     END V;
77 
 
78 
     PACKAGE BODY PKG IS
79 
 
80 
          TASK BODY PARENT IS
81 
               N : INTEGER := 1;
82 
          BEGIN
83 
               LOOP
84 
                    SELECT
85 
                         ACCEPT E (I : IN OUT INTEGER) DO
86 
                              I := I + N;
87 
                         END E;
88 
                    OR
89 
                         ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
90 
                              J := I + N;
91 
                         END F;
92 
                    OR
93 
                         ACCEPT G DO
94 
                              WHILE H(2)'COUNT < 2 LOOP
95 
                                   DELAY 5.0;
96 
                              END LOOP;
97 
                              ACCEPT H (2) DO
98 
                                   IF E'COUNT    /= 0 OR
99 
                                      F(1)'COUNT /= 0 OR
100 
                                      F(2)'COUNT /= 0 OR
101 
                                      F(3)'COUNT /= 0 OR
102 
                                      G'COUNT    /= 0 OR
103 
                                      H(1)'COUNT /= 0 OR
104 
                                      H(2)'COUNT /= 1 OR
105 
                                      H(3)'COUNT /= 0 OR
106 
                                      R'COUNT    /= 0 OR
107 
                                      W'COUNT    /= 0 THEN
108 
                                        FAILED ("INCORRECT 'COUNT");
109 
                                   END IF;
110 
                              END H;
111 
                              ACCEPT H (2);
112 
                         END G;
113 
                    OR
114 
                         ACCEPT R (I : OUT INTEGER) DO
115 
                              I := N;
116 
                         END R;
117 
                    OR
118 
                         ACCEPT W (I : INTEGER) DO
119 
                              N := I;
120 
                         END W;
121 
                    OR
122 
                         TERMINATE;
123 
                    END SELECT;
124 
               END LOOP;
125 
          END PARENT;
126 
 
127 
          FUNCTION ID (X : PARENT) RETURN INTEGER IS
128 
               I : INTEGER;
129 
          BEGIN
130 
               X.R (I);
131 
               RETURN I;
132 
          END ID;
133 
 
134 
     END PKG;
135 
 
136 
     TASK BODY AUX IS
137 
     BEGIN
138 
          X.H (2);
139 
     END AUX;
140 
 
141 
BEGIN
142 
     TEST ("C34008A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
143 
                      "ARE DECLARED (IMPLICITLY) FOR DERIVED TASK " &
144 
                      "TYPES");
145 
 
146 
     X.W (IDENT_INT (2));
147 
     IF ID (X) /= 2 THEN
148 
          FAILED ("INCORRECT INITIALIZATION");
149 
     END IF;
150 
 
151 
     IF ID (T'(X)) /= 2 THEN
152 
          FAILED ("INCORRECT QUALIFICATION");
153 
     END IF;
154 
 
155 
     IF ID (T (X)) /= 2 THEN
156 
          FAILED ("INCORRECT SELF CONVERSION");
157 
     END IF;
158 
 
159 
     W.W (IDENT_INT (3));
160 
     IF ID (T (W)) /= 3 THEN
161 
          FAILED ("INCORRECT CONVERSION FROM PARENT");
162 
     END IF;
163 
 
164 
     IF ID (PARENT (X)) /= 2 THEN
165 
          FAILED ("INCORRECT CONVERSION TO PARENT");
166 
     END IF;
167 
 
168 
     I := 5;
169 
     X.E (I);
170 
     IF I /= 7 THEN
171 
          FAILED ("INCORRECT SELECTION (ENTRY)");
172 
     END IF;
173 
 
174 
     I := 5;
175 
     X.F (IDENT_INT (2)) (I, J);
176 
     IF J /= 7 THEN
177 
          FAILED ("INCORRECT SELECTION (FAMILY)");
178 
     END IF;
179 
 
180 
     IF NOT (X IN T) THEN
181 
          FAILED ("INCORRECT ""IN""");
182 
     END IF;
183 
 
184 
     IF X NOT IN T THEN
185 
          FAILED ("INCORRECT ""NOT IN""");
186 
     END IF;
187 
 
188 
 
189 
     B := FALSE;
190 
     A (X'ADDRESS);
191 
     IF NOT B THEN
192 
          FAILED ("INCORRECT OBJECT'ADDRESS");
193 
     END IF;
194 
 
195 
     IF NOT X'CALLABLE THEN
196 
          FAILED ("INCORRECT OBJECT'CALLABLE");
197 
     END IF;
198 
 
199 
     IF NOT V'CALLABLE THEN
200 
          FAILED ("INCORRECT VALUE'CALLABLE");
201 
     END IF;
202 
 
203 
     X.G;
204 
 
205 
     IF X'SIZE < T'SIZE THEN
206 
          FAILED ("INCORRECT OBJECT'SIZE");
207 
     END IF;
208 
 
209 
     IF T'STORAGE_SIZE < 0 THEN
210 
          FAILED ("INCORRECT TYPE'STORAGE_SIZE");
211 
     END IF;
212 
 
213 
     IF X'STORAGE_SIZE < 0 THEN
214 
          FAILED ("INCORRECT OBJECT'STORAGE_SIZE");
215 
     END IF;
216 
 
217 
     IF X'TERMINATED THEN
218 
          FAILED ("INCORRECT OBJECT'TERMINATED");
219 
     END IF;
220 
 
221 
     IF V'TERMINATED THEN
222 
          FAILED ("INCORRECT VALUE'TERMINATED");
223 
     END IF;
224 
 
225 
     RESULT;
226 
END C34008A;

powered by: WebSVN 2.1.0

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