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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 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.