1-- CE3809A.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 FLOAT I/O GET CAN READ A VALUE FROM A STRING.
27--     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
28--     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
29--     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
30--     CHARACTER READ FROM THE STRING.
31
32-- HISTORY:
33--     SPS 10/07/82
34--     SPS 12/14/82
35--     JBG 12/21/82
36--     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
37--                   CHECKED THAT END_ERROR IS RAISED.
38
39WITH REPORT; USE REPORT;
40WITH TEXT_IO; USE TEXT_IO;
41
42PROCEDURE CE3809A IS
43BEGIN
44
45     TEST ("CE3809A", "CHECK THAT FLOAT_IO GET " &
46                      "OPERATES CORRECTLY ON STRINGS");
47
48     DECLARE
49          TYPE FL IS DIGITS 4;
50          PACKAGE FLIO IS NEW FLOAT_IO (FL);
51          USE FLIO;
52          X : FL;
53          STR : STRING (1..10) := "   10.25  ";
54          L : POSITIVE;
55     BEGIN
56
57-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
58          BEGIN
59               GET ("896.5  ", X, L);
60               IF X /= 896.5 THEN
61                    FAILED ("FLOAT VALUE FROM STRING INCORRECT");
62               END IF;
63          EXCEPTION
64               WHEN DATA_ERROR =>
65                    FAILED ("DATA_ERROR RAISED - FLOAT - 1");
66               WHEN OTHERS =>
67                    FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 1");
68          END;
69
70          IF L /= IDENT_INT (5) THEN
71               FAILED ("VALUE OF LAST INCORRECT - FLOAT - 1.  LAST IS" &
72                       INTEGER'IMAGE(L));
73          END IF;
74
75-- STRING LITERAL WITH BLANKS
76          BEGIN
77               GET ("   ", X, L);
78               FAILED ("END_ERROR NOT RAISED - FLOAT - 2");
79          EXCEPTION
80               WHEN END_ERROR =>
81                    IF L /= 5 THEN
82                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
83                                 "INCORRECT - 2.  LAST IS" &
84                                 INTEGER'IMAGE(L));
85                    END IF;
86               WHEN DATA_ERROR =>
87                    FAILED ("DATA_ERROR RAISED - FLOAT - 2");
88               WHEN OTHERS =>
89                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2");
90          END;
91
92-- NULL STRING LITERAL
93          BEGIN
94               GET ("", X, L);
95               FAILED ("END_ERROR NOT RAISED - FLOAT - 3");
96          EXCEPTION
97               WHEN END_ERROR =>
98                    IF L /= 5 THEN
99                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
100                                 "INCORRECT - 3.  LAST IS" &
101                                 INTEGER'IMAGE(L));
102                    END IF;
103               WHEN DATA_ERROR =>
104                    FAILED ("DATA_ERROR RAISED - FLOAT - 3");
105               WHEN OTHERS =>
106                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3");
107          END;
108
109-- NULL SLICE
110          BEGIN
111               GET (STR(5..IDENT_INT(2)), X, L);
112               FAILED ("END_ERROR NOT RAISED - FLOAT - 4");
113          EXCEPTION
114               WHEN END_ERROR =>
115                    IF L /= 5 THEN
116                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
117                                 "INCORRECT - 4.  LAST IS" &
118                                 INTEGER'IMAGE(L));
119                    END IF;
120               WHEN DATA_ERROR =>
121                    FAILED ("DATA_ERROR RAISED - FLOAT - 4");
122               WHEN OTHERS =>
123                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4");
124          END;
125
126-- SLICE WITH BLANKS
127          BEGIN
128               GET (STR(IDENT_INT(9)..10), X, L);
129               FAILED ("END_ERROR NOT RAISED - FLOAT - 5");
130          EXCEPTION
131               WHEN END_ERROR =>
132                    IF L /= IDENT_INT(5) THEN
133                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
134                                 "INCORRECT - 5.  LAST IS" &
135                                 INTEGER'IMAGE(L));
136                    END IF;
137               WHEN DATA_ERROR =>
138                    FAILED ("DATA_ERROR RAISED - FLOAT - 5");
139               WHEN OTHERS =>
140                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5");
141          END;
142
143-- NON-NULL SLICE
144          BEGIN
145               GET (STR(2..IDENT_INT(8)), X, L);
146               IF X /= 10.25 THEN
147                    FAILED ("FLOAT VALUE INCORRECT - 6");
148               END IF;
149               IF L /= 8 THEN
150                    FAILED ("LAST INCORRECT FOR SLICE - 6.  LAST IS" &
151                            INTEGER'IMAGE(L));
152               END IF;
153          EXCEPTION
154               WHEN OTHERS =>
155                    FAILED ("EXCEPTION RAISED - 6");
156          END;
157
158-- LEFT-JUSTIFIED, POSITIVE EXPONENT
159          BEGIN
160               GET ("1.34E+02", X, L);
161               IF X /= 134.0 THEN
162                    FAILED ("FLOAT WITH EXP FROM STRING INCORRECT - 7");
163               END IF;
164
165               IF L /= 8 THEN
166                    FAILED ("VALUE OF LAST INCORRECT - FLOAT - 7.  " &
167                            "LAST IS" & INTEGER'IMAGE(L));
168               END IF;
169          EXCEPTION
170               WHEN DATA_ERROR =>
171                    FAILED ("DATA_EROR RAISED - FLOAT - 7");
172               WHEN OTHERS =>
173                    FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 7");
174          END;
175
176-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
177          BEGIN
178               GET (" 25.0E-2", X, L);
179               IF X /= 0.25 THEN
180                    FAILED ("NEG EXPONENT INCORRECT - 8");
181               END IF;
182               IF L /= 8 THEN
183                    FAILED ("LAST INCORRECT - 8.  LAST IS" &
184                            INTEGER'IMAGE(L));
185               END IF;
186          EXCEPTION
187               WHEN OTHERS =>
188                    FAILED ("EXCEPTION RAISED - 8");
189          END;
190
191-- RIGHT-JUSTIFIED, NEGATIVE
192          GET ("  -1.50", X, L);
193          IF X /= -1.5 THEN
194               FAILED ("FLOAT IN RIGHT JUSTIFIED STRING INCORRECT - 9");
195          END IF;
196          IF L /= 7 THEN
197               FAILED ("LAST INCORRECT - 9.  LAST IS" &
198                       INTEGER'IMAGE(L));
199          END IF;
200
201-- HORIZONTAL TAB WITH BLANKS
202          BEGIN
203               GET (" " & ASCII.HT & "2.3E+2", X, L);
204               IF X /= 230.0 THEN
205                    FAILED ("FLOAT WITH TAB IN STRING INCORRECT - 10");
206               END IF;
207               IF L /= 8 THEN
208                    FAILED ("LAST INCORRECT FOR TAB - 10.  LAST IS" &
209                            INTEGER'IMAGE(L));
210               END IF;
211          EXCEPTION
212               WHEN DATA_ERROR =>
213                    FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
214               WHEN OTHERS =>
215                    FAILED ("SOME EXCEPTION RAISED FOR STRING WITH " &
216                            "TAB - 10");
217          END;
218
219-- HORIZONTAL TABS ONLY
220          BEGIN
221               GET (ASCII.HT & ASCII.HT, X, L);
222               FAILED ("END_ERROR NOT RAISED - FLOAT - 11");
223          EXCEPTION
224               WHEN END_ERROR =>
225                    IF L /= IDENT_INT(8) THEN
226                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
227                                 "INCORRECT - 11.  LAST IS" &
228                                 INTEGER'IMAGE(L));
229                    END IF;
230               WHEN DATA_ERROR =>
231                    FAILED ("DATA_ERROR RAISED - FLOAT - 11");
232               WHEN OTHERS =>
233                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 11");
234          END;
235     END;
236
237     RESULT;
238
239END CE3809A;
240