1-- C35503E.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
27--     THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL
28--     PARAMETER IS AN INTEGER TYPE.
29--     SUBTESTS ARE :
30--         PART (A). TESTS FOR 'IMAGE'.
31--         PART (B). TESTS FOR 'VALUE'.
32
33-- HISTORY:
34--     RJW 03/17/86 CREATED ORIGINAL TEST.
35--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
36
37WITH REPORT; USE REPORT;
38
39PROCEDURE C35503E IS
40
41BEGIN
42     TEST ("C35503E", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE " &
43                      "CORRECT RESULTS  WHEN THE PREFIX IS A " &
44                      "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
45                      "PARAMETER IS AN INTEGER TYPE" );
46-- PART (A).
47
48     DECLARE
49          TYPE NEWINT IS NEW INTEGER RANGE -2000 .. 2000;
50
51          GENERIC
52               TYPE INT IS (<>);
53          PROCEDURE P (I1 : INT; STR : STRING );
54
55          PROCEDURE P (I1 : INT; STR : STRING) IS
56               SUBTYPE SUBINT IS INT
57               RANGE INT'VAL (IDENT_INT(-1000)) ..
58                                              INT'VAL (IDENT_INT(1000));
59          BEGIN
60
61               IF INT'IMAGE (I1) /= STR THEN
62                    FAILED ( "INCORRECT INT'IMAGE OF " & STR );
63               END IF;
64               IF INT'IMAGE (I1)'FIRST /= 1 THEN
65                    FAILED ( "INCORRECT LOWER BOUND FOR INT'IMAGE OF " &
66                             STR );
67               END IF;
68
69               IF SUBINT'IMAGE (I1) /= STR THEN
70                    FAILED ( "INCORRECT SUBINT'IMAGE OF " & STR );
71               END IF;
72               IF SUBINT'IMAGE (I1)'FIRST /= 1 THEN
73                    FAILED ( "INCORRECT LOWER BOUND FOR SUBINT'IMAGE " &
74                             "OF " & STR );
75               END IF;
76
77          END P;
78
79          PROCEDURE PROC1 IS NEW P (INTEGER);
80          PROCEDURE PROC2 IS NEW P (NEWINT);
81
82     BEGIN
83          PROC1 (-500, "-500");
84          PROC2 (0, " 0");
85          PROC2 (99," 99");
86     END;
87
88-----------------------------------------------------------------------
89
90-- PART (B).
91
92     DECLARE
93          TYPE NEWINT IS NEW INTEGER;
94
95          GENERIC
96               TYPE INT IS (<>);
97          PROCEDURE P (STR : STRING; I1 : INT );
98
99          PROCEDURE P (STR : STRING; I1 : INT) IS
100               SUBTYPE SUBINT IS INT
101                    RANGE INT'VAL (IDENT_INT(0)) ..
102                                                INT'VAL (IDENT_INT(10));
103
104          BEGIN
105               BEGIN
106                    IF INT'VALUE (STR) /= I1 THEN
107                         FAILED ( "INCORRECT INT'VALUE OF """ &
108                                  STR & """");
109                    END IF;
110               EXCEPTION
111                    WHEN OTHERS =>
112                         FAILED ( "EXCEPTION RAISED INT'VALUE OF """ &
113                                  STR & """");
114               END;
115               BEGIN
116                    IF SUBINT'VALUE (STR) /= I1 THEN
117                         FAILED ( "INCORRECT SUBINT'VALUE OF """ &
118                                  STR & """");
119                    END IF;
120               EXCEPTION
121                    WHEN OTHERS =>
122                         FAILED ( "EXCEPTION RAISED SUBINT'VALUE " &
123                                  "OF """ & STR & """");
124               END;
125          END P;
126
127          PROCEDURE PROC1 IS NEW P (INTEGER);
128          PROCEDURE PROC2 IS NEW P (NEWINT);
129
130     BEGIN
131               PROC1 ("-500" , -500);
132               PROC2 (" -001E2 " , -100);
133               PROC1 ("3_45" , 345);
134               PROC2 ("-2#1111_1111#" , -255);
135               PROC1 ("16#FF#" , 255);
136               PROC2 ("-016#0FF#" , -255);
137               PROC1 ("2#1110_0000#     " , 224);
138               PROC2 ("-16#E#E1" , -224);
139
140     END;
141
142     DECLARE
143          TYPE NEWINT IS NEW INTEGER;
144
145          GENERIC
146               TYPE INT IS (<>);
147          PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING);
148
149          PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING) IS
150               SUBTYPE SUBINT IS INT
151                    RANGE INT'VAL (IDENT_INT(0)) ..
152                                                INT'VAL (IDENT_INT(10));
153
154          BEGIN
155               BEGIN
156                    IF INT'VALUE (STR1) = I1 THEN
157                         FAILED ( "NO EXCEPTION RAISED - INT'VALUE " &
158                                  "WITH " & STR2 & " - EQUAL");
159                    ELSE
160                         FAILED ( "NO EXCEPTION RAISED " &
161                                  "- INT'VALUE WITH " &
162                                  STR2 & " - NOT EQUAL" );
163                    END IF;
164               EXCEPTION
165                    WHEN CONSTRAINT_ERROR =>
166                         NULL;
167                    WHEN OTHERS =>
168                         FAILED ( "WRONG EXCEPTION RAISED - " &
169                                  "INT'VALUE WITH " & STR2 );
170               END;
171               BEGIN
172                    IF SUBINT'VALUE (STR1) = I1 THEN
173                         FAILED ( "NO EXCEPTION RAISED - " &
174                                  "SUBINT'VALUE WITH " & STR2
175                                   & " - EQUAL" );
176                    ELSE
177                         FAILED ( "NO EXCEPTION RAISED - " &
178                                  "SUBINT'VALUE WITH " &
179                                   STR2 & " - NOT EQUAL" );
180                    END IF;
181               EXCEPTION
182                    WHEN CONSTRAINT_ERROR =>
183                         NULL;
184                    WHEN OTHERS =>
185                         FAILED ( "WRONG EXCEPTION RAISED  - " &
186                                  "SUBINT'VALUE WITH " & STR2 );
187               END;
188          END P;
189
190          PROCEDURE PROC1 IS NEW P (INTEGER);
191          PROCEDURE PROC2 IS NEW P (NEWINT);
192
193     BEGIN
194          PROC1 ("1.0"           , 1,      "DECIMAL POINT");
195          PROC1 (ASCII.HT & "244", 244,    "LEADING 'HT'" );
196          PROC2 ("244" & ASCII.HT, 244,    "TRAILING 'HT'" );
197          PROC1 ("2__44"         , 244,    "CONSECUTIVE '_'" );
198          PROC2 ("_244"          , 244,    "LEADING '_'" );
199          PROC1 ("244_"          , 244,    "TRAILING '_'" );
200          PROC2 ("244_E1"        , 2440,   "'_' BEFORE 'E'" );
201          PROC1 ("244E_1"        , 2440,   "'_' FOLLOWING 'E'" );
202          PROC2 ("244_e1"        , 2440,   "'_' BEFORE 'e'" );
203          PROC1 ("16#_FF#"       , 255,    "'_' IN BASED LITERAL" );
204          PROC2 ("1E-0"          ,   0,    "NEGATIVE EXPONENT" );
205          PROC1 ("244."          , 244,    "TRAILING '.'" );
206          PROC2 ("8#811#"        , 0,      "DIGITS OUTSIDE OF RANGE" );
207          PROC1 ("1#000#"        , 0,      "BASE LESS THAN 2" );
208          PROC2 ("17#0#"         , 0,      "BASE GREATER THAN 16" );
209     END;
210
211     RESULT;
212END C35503E;
213