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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c7/] [c74203a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C74203A.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 MEMBERSHIP TESTS, QUALIFICATION, AND EXPLICIT
27
--     CONVERSION ARE AVAILABLE FOR LIMITED AND NON-LIMITED PRIVATE
28
--     TYPES.  INCLUDE TYPES WITH DISCRIMINANTS AND TYPES
29
--     WITH LIMITED COMPONENTS.
30
 
31
-- HISTORY:
32
--     BCB 03/10/88  CREATED ORIGINAL TEST.
33
 
34
WITH REPORT; USE REPORT;
35
 
36
PROCEDURE C74203A IS
37
 
38
     PACKAGE PP IS
39
          TYPE LIM IS LIMITED PRIVATE;
40
          PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER);
41
 
42
          TYPE A IS PRIVATE;
43
          SUBTYPE SUBA IS A;
44
          A1 : CONSTANT A;
45
 
46
          TYPE B IS LIMITED PRIVATE;
47
          B1 : CONSTANT B;
48
 
49
          TYPE C IS PRIVATE;
50
          C1 : CONSTANT C;
51
 
52
          TYPE D IS LIMITED PRIVATE;
53
          D1 : CONSTANT D;
54
 
55
          TYPE E (DISC1 : INTEGER := 5) IS PRIVATE;
56
          SUBTYPE SUBE IS E;
57
          E1 : CONSTANT E;
58
 
59
          TYPE F (DISC2 : INTEGER := 15) IS LIMITED PRIVATE;
60
          F1 : CONSTANT F;
61
 
62
          TYPE G (DISC3 : INTEGER) IS PRIVATE;
63
          G1 : CONSTANT G;
64
 
65
          TYPE H (DISC4 : INTEGER) IS LIMITED PRIVATE;
66
          H1 : CONSTANT H;
67
 
68
          TYPE I IS RECORD
69
               COMPI : LIM;
70
          END RECORD;
71
          SUBTYPE SUBI IS I;
72
 
73
          TYPE J IS ARRAY(1..5) OF LIM;
74
          SUBTYPE SUBJ IS J;
75
 
76
          TYPE S1 IS (VINCE, TOM, PHIL, JODIE, ROSA, TERESA);
77
          TYPE S2 IS (THIS, THAT, THESE, THOSE, THEM);
78
          TYPE S3 IS RANGE 1 .. 100;
79
          TYPE S4 IS RANGE 1 .. 100;
80
     PRIVATE
81
          TYPE LIM IS RANGE 1 .. 100;
82
 
83
          TYPE A IS (RED, BLUE, GREEN, YELLOW, BLACK, WHITE);
84
          A1 : CONSTANT A := BLUE;
85
 
86
          TYPE B IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
87
          B1 : CONSTANT B := THREE;
88
 
89
          TYPE C IS RANGE 1 .. 100;
90
          C1 : CONSTANT C := 50;
91
 
92
          TYPE D IS RANGE 1 .. 100;
93
          D1 : CONSTANT D := 50;
94
 
95
          TYPE E (DISC1 : INTEGER := 5) IS RECORD
96
               COMPE : S1;
97
          END RECORD;
98
          E1 : CONSTANT E := (DISC1 => 5, COMPE => TOM);
99
 
100
          TYPE F (DISC2 : INTEGER := 15) IS RECORD
101
               COMPF : S2;
102
          END RECORD;
103
          F1 : CONSTANT F := (DISC2 => 15, COMPF => THAT);
104
 
105
          TYPE G (DISC3 : INTEGER) IS RECORD
106
               COMPG : S3;
107
          END RECORD;
108
          G1 : CONSTANT G := (DISC3 => 25, COMPG => 50);
109
 
110
          TYPE H (DISC4 : INTEGER) IS RECORD
111
               COMPH : S4;
112
          END RECORD;
113
          H1 : CONSTANT H := (DISC4 => 30, COMPH => 50);
114
     END PP;
115
 
116
     USE PP;
117
 
118
     AVAR : SUBA := A1;
119
     EVAR : SUBE := E1;
120
 
121
     IVAR : SUBI;
122
     JVAR : SUBJ;
123
 
124
     PACKAGE BODY PP IS
125
          PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER) IS
126
          BEGIN
127
               Z1 := LIM (Z2);
128
          END INIT;
129
     BEGIN
130
          NULL;
131
     END PP;
132
 
133
     PROCEDURE QUAL_PRIV (W : A) IS
134
     BEGIN
135
          NULL;
136
     END QUAL_PRIV;
137
 
138
     PROCEDURE QUAL_LIM_PRIV (X : B) IS
139
     BEGIN
140
          NULL;
141
     END QUAL_LIM_PRIV;
142
 
143
     PROCEDURE EXPL_CONV_PRIV_1 (Y : C) IS
144
     BEGIN
145
          NULL;
146
     END EXPL_CONV_PRIV_1;
147
 
148
     PROCEDURE EXPL_CONV_LIM_PRIV_1 (Z : D) IS
149
     BEGIN
150
          NULL;
151
     END EXPL_CONV_LIM_PRIV_1;
152
 
153
     PROCEDURE EXPL_CONV_PRIV_2 (Y2 : G) IS
154
     BEGIN
155
          NULL;
156
     END EXPL_CONV_PRIV_2;
157
 
158
     PROCEDURE EXPL_CONV_LIM_PRIV_2 (Z2 : H) IS
159
     BEGIN
160
          NULL;
161
     END EXPL_CONV_LIM_PRIV_2;
162
 
163
     PROCEDURE EXPL_CONV_PRIV_3 (Y3 : I) IS
164
     BEGIN
165
          NULL;
166
     END EXPL_CONV_PRIV_3;
167
 
168
     PROCEDURE EXPL_CONV_PRIV_4 (Y4 : J) IS
169
     BEGIN
170
          NULL;
171
     END EXPL_CONV_PRIV_4;
172
 
173
BEGIN
174
     TEST ("C74203A", "CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, " &
175
                      "AND EXPLICIT CONVERSION ARE AVAILABLE FOR " &
176
                      "LIMITED AND NON-LIMITED PRIVATE TYPES.  " &
177
                      "INCLUDE TYPES WITH DISCRIMINANTS AND " &
178
                      "TYPES WITH LIMITED COMPONENTS");
179
 
180
     INIT (IVAR.COMPI, 50);
181
 
182
     FOR K IN IDENT_INT (1) .. IDENT_INT (5) LOOP
183
          INIT (JVAR(K), 25);
184
     END LOOP;
185
 
186
     IF NOT (AVAR IN A) THEN
187
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
188
                  "PRIVATE TYPE - 1");
189
     END IF;
190
 
191
     IF (AVAR NOT IN A) THEN
192
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
193
                  "PRIVATE TYPE - 1");
194
     END IF;
195
 
196
     IF NOT (B1 IN B) THEN
197
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
198
                  "LIMITED PRIVATE TYPE - 1");
199
     END IF;
200
 
201
     IF (B1 NOT IN B) THEN
202
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
203
                  "LIMITED PRIVATE TYPE - 1");
204
     END IF;
205
 
206
     QUAL_PRIV (A'(AVAR));
207
 
208
     QUAL_LIM_PRIV (B'(B1));
209
 
210
     EXPL_CONV_PRIV_1 (C(C1));
211
 
212
     EXPL_CONV_LIM_PRIV_1 (D(D1));
213
 
214
     IF NOT (EVAR IN E) THEN
215
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
216
                  "PRIVATE TYPE - 2");
217
     END IF;
218
 
219
     IF (EVAR NOT IN E) THEN
220
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
221
                  "PRIVATE TYPE - 2");
222
     END IF;
223
 
224
     IF NOT (F1 IN F) THEN
225
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
226
                  "LIMITED PRIVATE TYPE - 2");
227
     END IF;
228
 
229
     IF (F1 NOT IN F) THEN
230
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
231
                  "LIMITED PRIVATE TYPE - 2");
232
     END IF;
233
 
234
     EXPL_CONV_PRIV_2 (G(G1));
235
 
236
     EXPL_CONV_LIM_PRIV_2 (H(H1));
237
 
238
     IF NOT (IVAR IN I) THEN
239
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
240
                  "PRIVATE TYPE - 3");
241
     END IF;
242
 
243
     IF (IVAR NOT IN I) THEN
244
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
245
                  "PRIVATE TYPE - 3");
246
     END IF;
247
 
248
     EXPL_CONV_PRIV_3 (I(IVAR));
249
 
250
     IF NOT (JVAR IN J) THEN
251
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
252
                  "PRIVATE TYPE - 4");
253
     END IF;
254
 
255
     IF (JVAR NOT IN J) THEN
256
          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
257
                  "PRIVATE TYPE - 4");
258
     END IF;
259
 
260
     EXPL_CONV_PRIV_4 (J(JVAR));
261
 
262
     RESULT;
263
END C74203A;

powered by: WebSVN 2.1.0

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