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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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