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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c34014a.ada] - Blame information for rev 316

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C34014A.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 A DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
27 
--     UNDER APPROPRIATE CIRCUMSTANCES.
28 
 
29 
--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
30 
--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
31 
--     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
32 
 
33 
-- HISTORY:
34 
--     JRK 09/08/87  CREATED ORIGINAL TEST.
35 
 
36 
WITH REPORT; USE REPORT;
37 
 
38 
PROCEDURE C34014A IS
39 
 
40 
     PACKAGE P IS
41 
          TYPE T IS RANGE -100 .. 100;
42 
          FUNCTION F RETURN T;
43 
     END P;
44 
     USE P;
45 
 
46 
     PACKAGE BODY P IS
47 
          FUNCTION F RETURN T IS
48 
          BEGIN
49 
               RETURN T (IDENT_INT (1));
50 
          END F;
51 
     END P;
52 
 
53 
BEGIN
54 
     TEST ("C34014A", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
55 
                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
56 
                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
57 
                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
58 
                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
59 
                      "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
60 
                      "THE SAME VISIBLE PART");
61 
 
62 
     -----------------------------------------------------------------
63 
 
64 
     COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
65 
 
66 
     DECLARE
67 
 
68 
          PACKAGE Q IS
69 
               TYPE QT IS NEW T;
70 
               X : QT := F;
71 
               FUNCTION F RETURN QT;
72 
               TYPE QR IS
73 
                    RECORD
74 
                         C : QT := F;
75 
                    END RECORD;
76 
          PRIVATE
77 
               TYPE QS IS NEW QT;
78 
          END Q;
79 
          USE Q;
80 
 
81 
          PACKAGE BODY Q IS
82 
               FUNCTION F RETURN QT IS
83 
               BEGIN
84 
                    RETURN QT (IDENT_INT (2));
85 
               END F;
86 
 
87 
               PACKAGE R IS
88 
                    Y : QR;
89 
                    Z : QS := F;
90 
               END R;
91 
               USE R;
92 
          BEGIN
93 
               IF X /= 1 THEN
94 
                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
95 
                            "DECL");
96 
               END IF;
97 
 
98 
               IF Y.C /= 2 THEN
99 
                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
100 
                            "DECL - 1");
101 
               END IF;
102 
 
103 
               IF Z /= 2 THEN
104 
                    FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
105 
                            "DECL - 1");
106 
               END IF;
107 
          END Q;
108 
 
109 
          PACKAGE R IS
110 
               Y : QT := F;
111 
               TYPE RT IS NEW QT;
112 
               Z : RT := F;
113 
          END R;
114 
          USE R;
115 
 
116 
     BEGIN
117 
          IF Y /= 2 THEN
118 
               FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
119 
          END IF;
120 
 
121 
          IF Z /= 2 THEN
122 
               FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
123 
          END IF;
124 
     END;
125 
 
126 
     -----------------------------------------------------------------
127 
 
128 
     COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
129 
 
130 
     DECLARE
131 
 
132 
          PACKAGE Q IS
133 
               TYPE QT IS NEW T;
134 
               X : QT := F;
135 
               FUNCTION G RETURN QT;
136 
               FUNCTION F RETURN QT RENAMES G;
137 
               TYPE QR IS
138 
                    RECORD
139 
                         C : QT := F;
140 
                    END RECORD;
141 
          PRIVATE
142 
               TYPE QS IS NEW QT;
143 
          END Q;
144 
          USE Q;
145 
 
146 
          PACKAGE BODY Q IS
147 
               FUNCTION G RETURN QT IS
148 
               BEGIN
149 
                    RETURN QT (IDENT_INT (2));
150 
               END G;
151 
 
152 
               PACKAGE R IS
153 
                    Y : QR;
154 
                    Z : QS := F;
155 
               END R;
156 
               USE R;
157 
          BEGIN
158 
               IF X /= 1 THEN
159 
                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING");
160 
               END IF;
161 
 
162 
               IF Y.C /= 2 THEN
163 
                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
164 
                            "1");
165 
               END IF;
166 
 
167 
               IF Z /= 2 THEN
168 
                    FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
169 
                            "1");
170 
               END IF;
171 
          END Q;
172 
 
173 
          PACKAGE R IS
174 
               Y : QT := F;
175 
               TYPE RT IS NEW QT;
176 
               Z : RT := F;
177 
          END R;
178 
          USE R;
179 
 
180 
     BEGIN
181 
          IF Y /= 2 THEN
182 
               FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 2");
183 
          END IF;
184 
 
185 
          IF Z /= 2 THEN
186 
               FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
187 
          END IF;
188 
     END;
189 
 
190 
     -----------------------------------------------------------------
191 
 
192 
     COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
193 
 
194 
     DECLARE
195 
 
196 
          GENERIC
197 
               TYPE T IS RANGE <>;
198 
          FUNCTION G RETURN T;
199 
 
200 
          FUNCTION G RETURN T IS
201 
          BEGIN
202 
               RETURN T (IDENT_INT (2));
203 
          END G;
204 
 
205 
          PACKAGE Q IS
206 
               TYPE QT IS NEW T;
207 
               X : QT := F;
208 
               FUNCTION F IS NEW G (QT);
209 
               W : QT := F;
210 
          PRIVATE
211 
               TYPE QS IS NEW QT;
212 
               Z : QS := F;
213 
          END Q;
214 
          USE Q;
215 
 
216 
          PACKAGE BODY Q IS
217 
          BEGIN
218 
               IF X /= 1 THEN
219 
                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
220 
                            "INSTANTIATION");
221 
               END IF;
222 
 
223 
               IF W /= 2 THEN
224 
                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
225 
                            "INSTANTIATION - 1");
226 
               END IF;
227 
 
228 
               IF Z /= 2 THEN
229 
                    FAILED ("NEW SUBPROGRAM NOT DERIVED - " &
230 
                            "INSTANTIATION - 1");
231 
               END IF;
232 
          END Q;
233 
 
234 
          PACKAGE R IS
235 
               Y : QT := F;
236 
               TYPE RT IS NEW QT;
237 
               Z : RT := F;
238 
          END R;
239 
          USE R;
240 
 
241 
     BEGIN
242 
          IF Y /= 2 THEN
243 
               FAILED ("NEW SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
244 
                       "2");
245 
          END IF;
246 
 
247 
          IF Z /= 2 THEN
248 
               FAILED ("NEW SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
249 
                       "2");
250 
          END IF;
251 
     END;
252 
 
253 
     -----------------------------------------------------------------
254 
 
255 
     RESULT;
256 
END C34014A;

powered by: WebSVN 2.1.0

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