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/] [c35502c.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C35502C.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 THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
26
-- RESULTS WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN
27
-- OR A CHARACTER TYPE.   
28
-- SUBTESTS ARE:
29
--     PART (A). TESTS FOR IMAGE.
30
--     PART (B). TESTS FOR VALUE.
31
 
32
-- RJW 5/07/86
33
 
34
WITH REPORT; USE REPORT;
35
 
36
PROCEDURE  C35502C  IS
37
 
38
          TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
39
          SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
40
 
41
          TYPE NEWENUM IS NEW ENUM;
42
 
43
          FUNCTION IDENT (X : ENUM) RETURN ENUM IS
44
               BEGIN
45
                    IF EQUAL (ENUM'POS (X), ENUM'POS(X)) THEN
46
                         RETURN X;
47
                    END IF;
48
                    RETURN ENUM'FIRST;
49
               END IDENT;
50
 
51
BEGIN
52
 
53
     TEST( "C35502C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
54
                       "'VALUE' YIELD THE CORRECT RESULTS " &
55
                       "WHEN THE PREFIX IS AN ENUMERATION TYPE " &
56
                       "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
57
 
58
-- PART (A).
59
 
60
     BEGIN
61
 
62
          IF ENUM'IMAGE ( IDENT(ABC) ) /= "ABC" THEN
63
               FAILED ( "INCORRECT ENUM'IMAGE FOR ABC" );
64
          END IF;
65
          IF ENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
66
               FAILED ( "INCORRECT LOWER BOUND FOR ABC IN ENUM" );
67
          END IF;
68
 
69
          IF ENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
70
               FAILED ( "INCORRECT ENUM'IMAGE FOR A_B_C" );
71
          END IF;
72
          IF ENUM'IMAGE ( IDENT(A_B_C) )'FIRST /= 1 THEN
73
               FAILED ( "INCORRECT LOWER BOUND FOR A_B_C IN ENUM" );
74
          END IF;
75
 
76
          IF SUBENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
77
               FAILED ( "INCORRECT SUBENUM'IMAGE FOR A_B_C" );
78
          END IF;
79
          IF SUBENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
80
               FAILED ( "INCORRECT LOWER BOUND FOR ABC " &
81
                        "IN SUBENUM" );
82
          END IF;
83
 
84
          IF NEWENUM'IMAGE ( ABC ) /= IDENT_STR("ABC") THEN
85
               FAILED ( "INCORRECT NEWENUM'IMAGE FOR ABC" );
86
          END IF;
87
          IF NEWENUM'IMAGE ( ABC )'FIRST /= IDENT_INT(1) THEN
88
               FAILED ( "INCORRECT LOWER BOUND FOR ABC" &
89
                        "IN NEWENUM" );
90
          END IF;
91
 
92
          IF ENUM'IMAGE ( IDENT(abcd) ) /= "ABCD" THEN
93
               FAILED ( "INCORRECT ENUM'IMAGE FOR abcd" );
94
          END IF;
95
          IF ENUM'IMAGE ( IDENT(abcd) )'FIRST /= 1 THEN
96
               FAILED ( "INCORRECT LOWER BOUND FOR abcd IN ENUM" );
97
          END IF;
98
 
99
     END;
100
 
101
-----------------------------------------------------------------------
102
 
103
-- PART (B).
104
 
105
     BEGIN
106
          IF ENUM'VALUE (IDENT_STR("ABC")) /= ABC THEN
107
               FAILED ( "INCORRECT VALUE FOR ""ABC""" );
108
          END IF;
109
     EXCEPTION
110
          WHEN OTHERS =>
111
               FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABC""" );
112
     END;
113
 
114
     BEGIN
115
          IF ENUM'VALUE (IDENT_STR("abc")) /= abc THEN
116
               FAILED ( "INCORRECT VALUE FOR ""abc""" );
117
          END IF;
118
     EXCEPTION
119
          WHEN OTHERS =>
120
               FAILED ( "EXCEPTION RAISED - VALUE FOR ""abc""" );
121
     END;
122
 
123
     BEGIN
124
          IF ENUM'VALUE ("ABC") /= ABC THEN
125
               FAILED ( "INCORRECT VALUE FOR ABC" );
126
          END IF;
127
     EXCEPTION
128
          WHEN OTHERS =>
129
               FAILED ( "EXCEPTION RAISED - VALUE FOR ABC" );
130
     END;
131
 
132
     BEGIN
133
          IF NEWENUM'VALUE (IDENT_STR("abcd")) /= abcd THEN
134
               FAILED ( "INCORRECT VALUE FOR ""abcd""" );
135
          END IF;
136
     EXCEPTION
137
          WHEN OTHERS =>
138
               FAILED ( "EXCEPTION RAISED - VALUE FOR ""abcd""" );
139
     END;
140
 
141
     BEGIN
142
          IF NEWENUM'VALUE (IDENT_STR("ABCD")) /= abcd THEN
143
               FAILED ( "INCORRECT VALUE FOR ""ABCD""" );
144
          END IF;
145
     EXCEPTION
146
          WHEN OTHERS =>
147
               FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABCD""" );
148
     END;
149
 
150
     BEGIN
151
          IF NEWENUM'VALUE ("abcd") /= abcd THEN
152
               FAILED ( "INCORRECT VALUE FOR abcd" );
153
          END IF;
154
     EXCEPTION
155
          WHEN OTHERS =>
156
               FAILED ( "EXCEPTION RAISED - VALUE FOR abcd" );
157
     END;
158
 
159
     BEGIN
160
          IF SUBENUM'VALUE (IDENT_STR("A_B_C")) /= A_B_C THEN
161
               FAILED ( "INCORRECT VALUE FOR ""A_B_C""" );
162
          END IF;
163
     EXCEPTION
164
          WHEN OTHERS =>
165
               FAILED ( "EXCEPTION RAISED - VALUE FOR ""A_B_C""" );
166
     END;
167
 
168
     BEGIN
169
          IF ENUM'VALUE (IDENT_STR("ABC     ")) /= ABC THEN
170
               FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
171
          END IF;
172
     EXCEPTION
173
          WHEN OTHERS =>
174
               FAILED ( "EXCEPTION RAISED - VALUE WITH " &
175
                        "TRAILING BLANKS" );
176
     END;
177
 
178
     BEGIN
179
          IF NEWENUM'VALUE (IDENT_STR("  A_B_C")) /= A_B_C THEN
180
               FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
181
          END IF;
182
     EXCEPTION
183
          WHEN OTHERS =>
184
               FAILED ( "EXCEPTION RAISED - VALUE WITH LEADING " &
185
                        "BLANKS" );
186
     END;
187
 
188
     BEGIN
189
          IF ENUM'VALUE (IDENT_STR("A_BC")) /= ABC THEN
190
               FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 1" );
191
          ELSE
192
               FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 2" );
193
          END IF;
194
     EXCEPTION
195
          WHEN CONSTRAINT_ERROR =>
196
               NULL;
197
          WHEN OTHERS =>
198
               FAILED ( "WRONG EXCEPTION RAISED - ""A_BC""" );
199
     END;
200
 
201
     BEGIN
202
          IF ENUM'VALUE (IDENT_STR("A BC")) /= ABC THEN
203
               FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 1" );
204
          ELSE
205
               FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 2" );
206
          END IF;
207
     EXCEPTION
208
          WHEN CONSTRAINT_ERROR =>
209
               NULL;
210
          WHEN OTHERS =>
211
               FAILED ( "WRONG EXCEPTION RAISED - ""A BC""" );
212
     END;
213
 
214
     BEGIN
215
          IF ENUM'VALUE (IDENT_STR("A&BC")) /= ABC THEN
216
               FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 1" );
217
          ELSE
218
               FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 2" );
219
          END IF;
220
     EXCEPTION
221
          WHEN CONSTRAINT_ERROR =>
222
               NULL;
223
          WHEN OTHERS =>
224
               FAILED ( "WRONG EXCEPTION RAISED - ""A&BC""" );
225
     END;
226
 
227
     BEGIN
228
          IF ENUM'VALUE (IDENT_CHAR(ASCII.HT) & "BC") /= BC THEN
229
               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
230
          ELSE
231
               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
232
          END IF;
233
     EXCEPTION
234
          WHEN CONSTRAINT_ERROR =>
235
               NULL;
236
          WHEN OTHERS =>
237
               FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
238
     END;
239
 
240
     BEGIN
241
          IF NEWENUM'VALUE ("A" & (IDENT_CHAR(ASCII.HT))) /= A THEN
242
               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
243
          ELSE
244
               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
245
          END IF;
246
     EXCEPTION
247
          WHEN CONSTRAINT_ERROR =>
248
               NULL;
249
          WHEN OTHERS =>
250
               FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
251
     END;
252
 
253
     BEGIN
254
          IF ENUM'VALUE (IDENT_STR("B__C")) /= BC THEN
255
               FAILED ( "NO EXCEPTION RAISED - " &
256
                        "CONSECUTIVE UNDERSCORES - 1" );
257
          ELSE
258
               FAILED ( "NO EXCEPTION RAISED - " &
259
                        "CONSECUTIVE UNDERSCORES - 2" );
260
          END IF;
261
     EXCEPTION
262
          WHEN CONSTRAINT_ERROR =>
263
               NULL;
264
          WHEN OTHERS =>
265
               FAILED ( "WRONG EXCEPTION RAISED - " &
266
                        "CONSECUTIVE UNDERSCORES" );
267
     END;
268
 
269
     BEGIN
270
          IF NEWENUM'VALUE (IDENT_STR("BC_")) /= BC THEN
271
               FAILED ( "NO EXCEPTION RAISED - " &
272
                        "TRAILING UNDERSCORE - 1" );
273
          ELSE
274
               FAILED ( "NO EXCEPTION RAISED - " &
275
                        "TRAILING UNDERSCORE - 2" );
276
          END IF;
277
     EXCEPTION
278
          WHEN CONSTRAINT_ERROR =>
279
               NULL;
280
          WHEN OTHERS =>
281
               FAILED ( "WRONG EXCEPTION RAISED - " &
282
                        "TRAILING UNDERSCORE" );
283
     END;
284
 
285
     BEGIN
286
          IF SUBENUM'VALUE (IDENT_STR("_BC")) /= BC THEN
287
               FAILED ( "NO EXCEPTION RAISED - " &
288
                        "LEADING UNDERSCORE - 1" );
289
          ELSE
290
               FAILED ( "NO EXCEPTION RAISED - " &
291
                        "LEADING UNDERSCORE - 2" );
292
          END IF;
293
     EXCEPTION
294
          WHEN CONSTRAINT_ERROR =>
295
               NULL;
296
          WHEN OTHERS =>
297
               FAILED ( "WRONG EXCEPTION RAISED - " &
298
                        "LEADING UNDERSCORE" );
299
     END;
300
 
301
     BEGIN
302
          IF SUBENUM'VALUE (IDENT_STR("0BC")) /= BC THEN
303
               FAILED ( "NO EXCEPTION RAISED - " &
304
                        "FIRST CHARACTER IS A DIGIT - 1" );
305
          ELSE
306
               FAILED ( "NO EXCEPTION RAISED - " &
307
                        "FIRST CHARACTER IS A DIGIT - 2" );
308
          END IF;
309
     EXCEPTION
310
          WHEN CONSTRAINT_ERROR =>
311
               NULL;
312
          WHEN OTHERS =>
313
               FAILED ( "WRONG EXCEPTION RAISED - " &
314
                        "FIRST CHARACTER IS A DIGIT" );
315
     END;
316
 
317
     RESULT;
318
END C35502C;

powered by: WebSVN 2.1.0

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