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

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

Line No. Rev Author Line
1 294 jeremybenn
-- C35507C.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 ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
27
--     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
28
--     SUBTESTS ARE:
29
--         (A). TESTS FOR IMAGE.
30
--         (B). TESTS FOR VALUE.
31
 
32
-- HISTORY:
33
--     RJW 05/29/86  CREATED ORIGINAL TEST.
34
--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
35
--                   CORRECTED ERROR MESSAGES AND ADDED CALLS TO
36
--                   IDENT_STR.
37
 
38
WITH REPORT; USE REPORT;
39
 
40
PROCEDURE  C35507C  IS
41
 
42
     TYPE CHAR IS ('A', 'a');
43
 
44
     TYPE NEWCHAR IS NEW CHAR;
45
 
46
     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
47
     BEGIN
48
          RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
49
     END IDENT;
50
 
51
     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
52
     BEGIN
53
          RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
54
     END IDENT;
55
 
56
     PROCEDURE CHECK_BOUND (STR1, STR2 : STRING) IS
57
     BEGIN
58
          IF STR1'FIRST /= 1 THEN
59
               FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 &
60
                        "'IMAGE ('" & STR1 & "')" );
61
          END IF;
62
     END CHECK_BOUND;
63
 
64
BEGIN
65
 
66
     TEST( "C35507C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
67
                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
68
                       "PREFIX IS A CHARACTER TYPE" );
69
 
70
     BEGIN  -- (A).
71
          IF CHAR'IMAGE ('A') /= "'A'" THEN
72
               FAILED ( "INCORRECT IMAGE FOR CHAR'('A')" );
73
          END IF;
74
 
75
          CHECK_BOUND (CHAR'IMAGE ('A'), "CHAR");
76
 
77
          IF CHAR'IMAGE ('a') /= "'a'" THEN
78
               FAILED ( "INCORRECT IMAGE FOR CHAR'('a')" );
79
          END IF;
80
 
81
          CHECK_BOUND (CHAR'IMAGE ('a'), "CHAR");
82
 
83
          IF NEWCHAR'IMAGE ('A') /= "'A'" THEN
84
               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('A')" );
85
          END IF;
86
 
87
          CHECK_BOUND (NEWCHAR'IMAGE ('A'), "NEWCHAR");
88
 
89
          IF NEWCHAR'IMAGE ('a') /= "'a'" THEN
90
               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('a')" );
91
          END IF;
92
 
93
          CHECK_BOUND (NEWCHAR'IMAGE ('a'), "NEWCHAR");
94
 
95
          IF CHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
96
               FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('A'))" );
97
          END IF;
98
 
99
          CHECK_BOUND (CHAR'IMAGE (IDENT ('A')), "IDENT OF CHAR");
100
 
101
          IF CHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
102
               FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('a'))" );
103
          END IF;
104
 
105
          CHECK_BOUND (CHAR'IMAGE (IDENT ('a')), "IDENT OF CHAR");
106
 
107
          IF NEWCHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
108
               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('A'))" );
109
          END IF;
110
 
111
          CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('A')), "IDENT OF NEWCHAR");
112
 
113
          IF NEWCHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
114
               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('a'))" );
115
          END IF;
116
 
117
          CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('a')), "IDENT OF NEWCHAR");
118
 
119
          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
120
               IF CHARACTER'IMAGE (CH) /= ("'" & CH) & "'" THEN
121
                    FAILED ( "INCORRECT IMAGE FOR CHARACTER'(" &
122
                              CH & ")" );
123
               END IF;
124
 
125
               CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
126
 
127
          END LOOP;
128
 
129
          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
130
               CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
131
          END LOOP;
132
 
133
          CHECK_BOUND (CHARACTER'IMAGE (CHARACTER'VAL (127)),
134
                       "CHARACTER");
135
 
136
     END;
137
 
138
     ---------------------------------------------------------------
139
 
140
     DECLARE -- (B).
141
 
142
          SUBTYPE SUBCHAR IS CHARACTER
143
               RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
144
     BEGIN
145
          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
146
               IF SUBCHAR'VALUE (("'" & CH) & "'") /= CH THEN
147
                    FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & CH );
148
               END IF;
149
          END LOOP;
150
 
151
          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
152
               IF SUBCHAR'VALUE (CHARACTER'IMAGE (CH)) /= CH THEN
153
                    FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
154
                              CHARACTER'IMAGE (CH) );
155
               END IF;
156
          END LOOP;
157
 
158
          IF SUBCHAR'VALUE (CHARACTER'IMAGE (CHARACTER'VAL (127))) /=
159
             CHARACTER'VAL (127) THEN
160
               FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
161
                        "CHARACTER'VAL (127)" );
162
          END IF;
163
     END;
164
 
165
     BEGIN
166
          IF CHAR'VALUE ("'A'") /= 'A' THEN
167
               FAILED ( "INCORRECT VALUE FOR CHAR'(""'A'"")" );
168
          END IF;
169
 
170
          IF CHAR'VALUE ("'a'") /= 'a' THEN
171
               FAILED ( "INCORRECT VALUE FOR CHAR'(""'a'"")" );
172
          END IF;
173
 
174
          IF NEWCHAR'VALUE ("'A'") /= 'A' THEN
175
               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'A'"")" );
176
          END IF;
177
 
178
          IF NEWCHAR'VALUE ("'a'") /= 'a' THEN
179
               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'a'"")" );
180
          END IF;
181
     END;
182
 
183
     BEGIN
184
          IF CHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
185
               FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
186
                        "(""'A'""))" );
187
          END IF;
188
 
189
          IF CHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
190
               FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
191
                        "(""'a'""))" );
192
          END IF;
193
 
194
          IF NEWCHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
195
               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
196
                        "(""'A'""))" );
197
          END IF;
198
 
199
          IF NEWCHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
200
               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
201
                        "(""'a'""))" );
202
          END IF;
203
     END;
204
 
205
     BEGIN
206
          IF CHAR'VALUE (IDENT_STR ("'B'")) = 'A' THEN
207
               FAILED ( "NO EXCEPTION RAISED " &
208
                        "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 1" );
209
          ELSE
210
               FAILED ( "NO EXCEPTION RAISED " &
211
                        "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 2" );
212
          END IF;
213
     EXCEPTION
214
          WHEN CONSTRAINT_ERROR =>
215
               NULL;
216
          WHEN OTHERS =>
217
               FAILED ( "WRONG EXCEPTION RAISED " &
218
                        "FOR CHAR'VALUE (IDENT_STR (""'B'""))" );
219
     END;
220
 
221
     BEGIN
222
          IF CHARACTER'VALUE (IDENT_CHAR (ASCII.HT) & "'A'") = 'A' THEN
223
               FAILED ( "NO EXCEPTION RAISED FOR " &
224
                        "CHARACTER'VALUE " &
225
                        "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 1" );
226
          ELSE
227
               FAILED ( "NO EXCEPTION RAISED FOR " &
228
                        "CHARACTER'VALUE " &
229
                        "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 2" );
230
          END IF;
231
     EXCEPTION
232
          WHEN CONSTRAINT_ERROR =>
233
               NULL;
234
          WHEN OTHERS =>
235
               FAILED ( "WRONG EXCEPTION RAISED " &
236
                        "FOR CHARACTER'VALUE " &
237
                        "(IDENT_CHAR (ASCII.HT) & ""'A'"")" );
238
     END;
239
 
240
     BEGIN
241
          IF CHARACTER'VALUE ("'B'" & IDENT_CHAR (ASCII.HT)) = 'B' THEN
242
               FAILED ( "NO EXCEPTION RAISED FOR " &
243
                        "CHARACTER'VALUE (""'B'"" & " &
244
                        "IDENT_CHAR (ASCII.HT)) - 1" );
245
          ELSE
246
               FAILED ( "NO EXCEPTION RAISED FOR " &
247
                        "CHARACTER'VALUE (""'B'"" & " &
248
                        "IDENT_CHAR (ASCII.HT)) - 2" );
249
          END IF;
250
     EXCEPTION
251
          WHEN CONSTRAINT_ERROR =>
252
               NULL;
253
          WHEN OTHERS =>
254
               FAILED ( "WRONG EXCEPTION RAISED " &
255
                        "FOR CHARACTER'VALUE (""'B'"" & " &
256
                        "IDENT_CHAR (ASCII.HT)) " );
257
     END;
258
 
259
     BEGIN
260
          IF CHARACTER'VALUE ("'C'" & IDENT_CHAR (ASCII.BEL)) = 'C'
261
             THEN
262
               FAILED ( "NO EXCEPTION RAISED FOR " &
263
                        "CHARACTER'VALUE (""'C'"" & " &
264
                        "IDENT_CHAR (ASCII.BEL)) - 1" );
265
          ELSE
266
               FAILED ( "NO EXCEPTION RAISED FOR " &
267
                        "CHARACTER'VALUE (""'C'"" & " &
268
                        "IDENT_CHAR (ASCII.BEL)) - 2" );
269
          END IF;
270
     EXCEPTION
271
          WHEN CONSTRAINT_ERROR =>
272
               NULL;
273
          WHEN OTHERS =>
274
               FAILED ( "WRONG EXCEPTION RAISED " &
275
                        "FOR CHARACTER'VALUE (""'C'"" & " &
276
                        "IDENT_CHAR (ASCII.BEL))" );
277
     END;
278
 
279
     BEGIN
280
          IF CHARACTER'VALUE (IDENT_STR ("'")) = ''' THEN
281
               FAILED ( "NO EXCEPTION RAISED FOR " &
282
                        "CHARACTER'VALUE (IDENT_STR (""'"")) - 1" );
283
          ELSE
284
               FAILED ( "NO EXCEPTION RAISED FOR " &
285
                        "CHARACTER'VALUE (IDENT_STR (""'"")) - 2" );
286
          END IF;
287
     EXCEPTION
288
          WHEN CONSTRAINT_ERROR =>
289
               NULL;
290
          WHEN OTHERS =>
291
               FAILED ( "WRONG EXCEPTION RAISED " &
292
                        "FOR CHARACTER'VALUE (IDENT_STR (""'""))" );
293
     END;
294
 
295
     BEGIN
296
          IF CHARACTER'VALUE (IDENT_STR ("''")) = ''' THEN
297
               FAILED ( "NO EXCEPTION RAISED FOR " &
298
                        "CHARACTER'VALUE (IDENT_STR (""''"")) - 1" );
299
          ELSE
300
               FAILED ( "NO EXCEPTION RAISED FOR " &
301
                        "CHARACTER'VALUE (IDENT_STR (""''"")) - 2" );
302
          END IF;
303
     EXCEPTION
304
          WHEN CONSTRAINT_ERROR =>
305
               NULL;
306
          WHEN OTHERS =>
307
               FAILED ( "WRONG EXCEPTION RAISED " &
308
                        "FOR CHARACTER'VALUE (IDENT_STR (""''""))" );
309
     END;
310
 
311
     BEGIN
312
          IF CHARACTER'VALUE (IDENT_STR ("'A")) = 'A' THEN
313
               FAILED ( "NO EXCEPTION RAISED FOR " &
314
                        "CHARACTER'VALUE (IDENT_STR (""'A"")) - 1" );
315
          ELSE
316
               FAILED ( "NO EXCEPTION RAISED FOR " &
317
                        "CHARACTER'VALUE (IDENT_STR (""'A"")) - 2" );
318
          END IF;
319
     EXCEPTION
320
          WHEN CONSTRAINT_ERROR =>
321
               NULL;
322
          WHEN OTHERS =>
323
               FAILED ( "WRONG EXCEPTION RAISED " &
324
                        "FOR CHARACTER'VALUE IDENT_STR (""'A""))" );
325
     END;
326
 
327
     BEGIN
328
          IF CHARACTER'VALUE (IDENT_STR ("A'")) = 'A' THEN
329
               FAILED ( "NO EXCEPTION RAISED FOR " &
330
                        "CHARACTER'VALUE (IDENT_STR (""A'"")) - 1" );
331
          ELSE
332
               FAILED ( "NO EXCEPTION RAISED FOR " &
333
                        "CHARACTER'VALUE (IDENT_STR (""A'"")) - 2" );
334
          END IF;
335
     EXCEPTION
336
          WHEN CONSTRAINT_ERROR =>
337
               NULL;
338
          WHEN OTHERS =>
339
               FAILED ( "WRONG EXCEPTION RAISED " &
340
                        "FOR CHARACTER'VALUE (IDENT_STR (""A'""))" );
341
     END;
342
 
343
     BEGIN
344
          IF CHARACTER'VALUE (IDENT_STR ("'AB'")) = 'A' THEN
345
               FAILED ( "NO EXCEPTION RAISED FOR " &
346
                        "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 1" );
347
          ELSE
348
               FAILED ( "NO EXCEPTION RAISED FOR " &
349
                        "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 2" );
350
          END IF;
351
     EXCEPTION
352
          WHEN CONSTRAINT_ERROR =>
353
               NULL;
354
          WHEN OTHERS =>
355
               FAILED ( "WRONG EXCEPTION RAISED " &
356
                        "FOR CHARACTER'VALUE IDENT_STR (""'AB'""))" );
357
     END;
358
 
359
     RESULT;
360
END C35507C;

powered by: WebSVN 2.1.0

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