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.