1-- C35507E.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 FORMAL DISCRETE TYPE WHOSE ACTUAL
28--     PARAMETER IS A CHARACTER TYPE.
29--     SUBTESTS ARE:
30--         (A). TESTS FOR IMAGE.
31--         (B). TESTS FOR VALUE.
32
33-- HISTORY:
34--     RJW  05/29/86  CREATED ORIGINAL TEST.
35--     VCL  10/23/87  MODIFIED THIS HEADER, CHANGED THE CALLS TO
36--                    PROCEDURE 'PCH', IN THE SECOND PART OF SUBTEST B,
37--                    TO INCLUDE ANOTHER CALL TO PROCEDURE 'PCHAR' AND
38--                    CALLS TO PROCEDURE 'PNCHAR'.
39
40WITH REPORT; USE REPORT;
41PROCEDURE  C35507E  IS
42
43     TYPE CHAR IS ('A', 'a');
44
45     TYPE NEWCHAR IS NEW CHAR;
46
47     PROCEDURE CHECK_LOWER_BOUND (STR1, STR2 : STRING) IS
48     BEGIN
49          IF STR1'FIRST /= 1 THEN
50               FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & "'(" &
51                        STR1 & ")" );
52          END IF;
53     END CHECK_LOWER_BOUND;
54
55BEGIN
56
57     TEST( "C35507E" , "THE ATTRIBUTES 'IMAGE' AND " &
58                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
59                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
60                       "ACTUAL PARAMETER IS A CHARACTER TYPE" );
61
62     DECLARE -- (A).
63          GENERIC
64               TYPE CHTYPE IS (<>);
65               STR1 : STRING;
66          PROCEDURE P (CH : CHTYPE; STR2 : STRING);
67
68          PROCEDURE P (CH : CHTYPE; STR2 : STRING) IS
69               SUBTYPE SUBCH IS CHTYPE;
70          BEGIN
71               IF SUBCH'IMAGE (CH) /= STR2 THEN
72                    FAILED ( "INCORRECT IMAGE FOR " & STR1 & "'(" &
73                              STR2 & ")" );
74               END IF;
75
76               CHECK_LOWER_BOUND (SUBCH'IMAGE (CH), STR1);
77          END P;
78
79          PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR");
80          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
81          PROCEDURE PCH    IS NEW P (CHARACTER, "CHARACTER");
82
83     BEGIN
84          PCHAR ('A', "'A'");
85          PCHAR ('a', "'a'");
86          PNCHAR ('A', "'A'");
87          PNCHAR ('a', "'a'");
88
89          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
90               PCH (CH, ("'" & CH) & "'" );
91          END LOOP;
92     END;
93
94     DECLARE
95
96          GENERIC
97               TYPE CHTYPE IS (<>);
98          PROCEDURE P (CH : CHTYPE; STR : STRING);
99
100          PROCEDURE P (CH : CHTYPE; STR : STRING) IS
101               SUBTYPE SUBCH IS CHTYPE;
102          BEGIN
103               CHECK_LOWER_BOUND (CHTYPE'IMAGE (CH), "CHARACTER");
104          END P;
105
106          PROCEDURE PN IS NEW P (CHARACTER);
107
108     BEGIN
109
110          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
111               PN (CH, CHARACTER'IMAGE (CH));
112          END LOOP;
113
114          PN (ASCII.DEL, CHARACTER'IMAGE (ASCII.DEL));
115     END;
116
117     ---------------------------------------------------------------
118
119     DECLARE -- (B).
120
121          GENERIC
122               TYPE CHTYPE IS (<>);
123               STR1 : STRING;
124          PROCEDURE P (STR2 : STRING; CH : CHTYPE);
125
126          PROCEDURE P (STR2 : STRING; CH : CHTYPE) IS
127               SUBTYPE SUBCH IS CHTYPE;
128          BEGIN
129               IF SUBCH'VALUE (STR2) /= CH THEN
130                    FAILED ( "INCORRECT " & STR1 & "'VALUE FOR " &
131                              STR2 );
132               END IF;
133          END P;
134
135          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
136          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
137          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
138
139     BEGIN
140          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
141                PCH (CHARACTER'IMAGE (CH), CH );
142          END LOOP;
143
144          PCH (CHARACTER'IMAGE (CHARACTER'VAL (127)),
145               CHARACTER'VAL (127));
146
147          PCHAR ("'A'", 'A');
148          PCHAR ("'a'", 'a' );
149          PNCHAR ("'A'", 'A');
150          PNCHAR ("'a'", 'a');
151     END;
152
153     DECLARE
154          GENERIC
155               TYPE CHTYPE IS (<>);
156               STR1 : STRING;
157          PROCEDURE P (STR2 : STRING);
158
159          PROCEDURE P (STR2 : STRING) IS
160               SUBTYPE SUBCH IS CHTYPE;
161          BEGIN
162               IF SUBCH'VALUE (STR2) = SUBCH'VAL (0) THEN
163                    FAILED ( "NO EXCEPTION RAISED FOR " &
164                              STR1 & "'VALUE (" & STR2 & ") - 1" );
165               ELSE
166                    FAILED ( "NO EXCEPTION RAISED FOR " &
167                              STR1 & "'VALUE (" & STR2 & ") - 2" );
168               END IF;
169          EXCEPTION
170               WHEN CONSTRAINT_ERROR =>
171                    NULL;
172               WHEN OTHERS =>
173                    FAILED ( "WRONG EXCEPTION RAISED " &
174                             "FOR " & STR1 & "'VALUE (" & STR2 & ")" );
175          END P;
176
177          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
178          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
179          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
180
181     BEGIN
182          PCHAR ("'B'");
183          PCH (ASCII.HT & "'A'");
184          PCH ("'B'" & ASCII.HT);
185          PCH ("'C'" & ASCII.BEL);
186          PCH ("'");
187          PNCHAR ("''");
188          PCHAR ("'A");
189          PNCHAR ("A'");
190          PCH ("'AB'");
191     END;
192
193     RESULT;
194END C35507E;
195