1-- 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
38WITH REPORT; USE REPORT;
39
40PROCEDURE  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
64BEGIN
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;
360END C35507C;
361