1-- CE3704M.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 GET FOR INTEGER_IO RAISES DATA_ERROR WHEN
27--     THE INPUT CONTAINS
28--
29--     (1)  INTEGER_IO DECIMAL POINT
30--     (2)  INTEGER_IO LEADING OR TRAILING UNDERSCORES.
31
32-- APPLICABILITY CRITERIA:
33--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
34--     SUPPORT TEXT FILES.
35
36-- HISTORY:
37--     VKG 02/10/83
38--     CPP 07/30/84
39--     EG  05/22/85
40--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
41--                   RESULT WHEN FILES ARE NOT SUPPORTED.
42--     DWC 09/11/87  REMOVED UNNECESSARY CODE, CORRECTED
43--                   EXCEPTION HANDLING, AND ADDED CASES WHICH
44--                   CHECK GET AT THE END_OF_FILE.
45
46WITH REPORT; USE REPORT;
47WITH TEXT_IO; USE TEXT_IO;
48
49PROCEDURE CE3704M IS
50     INCOMPLETE : EXCEPTION;
51
52BEGIN
53
54     TEST ("CE3704M", "CHECK THAT DATA_ERROR IS RAISED FOR " &
55                      "INTEGER_IO WHEN A DECIMAL POINT, OR " &
56                      "LEADING OR TRAILING UNDERSCORES " &
57                      "ARE DETECTED");
58
59     DECLARE
60          FT : FILE_TYPE;
61          CH : CHARACTER;
62     BEGIN
63
64          BEGIN
65               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
66          EXCEPTION
67               WHEN USE_ERROR =>
68                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
69                                    "WITH OUT_FILE MODE");
70                    RAISE INCOMPLETE;
71               WHEN NAME_ERROR =>
72                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
73                                    "WITH OUT_FILE MODE");
74                    RAISE INCOMPLETE;
75          END;
76
77          PUT (FT, "3.14152");
78          NEW_LINE (FT);
79          PUT (FT, "2.15");
80          NEW_LINE (FT);
81          PUT (FT, "_312");
82          NEW_LINE (FT);
83          PUT (FT, "-312_");
84
85          CLOSE (FT);
86
87          DECLARE
88               PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
89               USE INT_IO;
90               X : INTEGER := 402;
91          BEGIN
92
93               BEGIN
94                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
95               EXCEPTION
96                    WHEN USE_ERROR =>
97                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
98                                         "OPEN WITH IN_FILE MODE");
99                         RAISE INCOMPLETE;
100               END;
101
102               BEGIN
103                    GET (FT, X, 3);
104                    FAILED ("DATA_ERROR NOT RAISED - (1)");
105               EXCEPTION
106                    WHEN DATA_ERROR =>
107                         NULL;
108                    WHEN OTHERS =>
109                         FAILED ("UNEXPECTED EXCEPTION RAISED - (1)");
110               END;
111
112               IF END_OF_LINE (FT) THEN
113                    FAILED ("GET STOPPED AT END OF LINE - (1)");
114               ELSE
115                    GET (FT, CH);
116                    IF CH /= '4' THEN
117                         FAILED ("GET STOPPED AT WRONG " &
118                                 "POSITION - (1): CHAR IS " & CH);
119                    END IF;
120               END IF;
121
122               SKIP_LINE (FT);
123
124               BEGIN
125                    GET (FT, X);
126                    IF X /= 2 THEN
127                         FAILED ("WRONG VALUE READ - (2)");
128                    END IF;
129               EXCEPTION
130                    WHEN DATA_ERROR =>
131                         FAILED ("DATA_ERROR RAISED - (2)");
132                    WHEN OTHERS =>
133                         FAILED ("UNEXPECTED EXCEPTION RAISED - (2)");
134               END;
135
136               IF END_OF_LINE (FT) THEN
137                    FAILED ("GET STOPPED AT END OF LINE - (2)");
138               ELSE
139                    GET (FT, CH);
140                    IF CH /= '.' THEN
141                         FAILED ("GET STOPPED AT WRONG " &
142                                 "POSITION - (2): CHAR IS " & CH);
143                    END IF;
144               END IF;
145
146               SKIP_LINE (FT);
147
148               BEGIN
149                    GET (FT, X);
150                    FAILED ("DATA_ERROR NOT RAISED - (3)");
151               EXCEPTION
152                    WHEN DATA_ERROR =>
153                         NULL;
154                    WHEN OTHERS =>
155                         FAILED ("UNEXPECTED EXCEPTION RAISED - (3)");
156               END;
157
158               IF END_OF_LINE (FT) THEN
159                    FAILED ("GET STOPPED AT END OF LINE - (3)");
160               ELSE
161                    GET (FT, CH);
162                    IF CH /= '_' THEN
163                         FAILED ("GET STOPPED AT WRONG POSITION " &
164                                 "- (3): CHAR IS " & CH);
165                    END IF;
166               END IF;
167
168               SKIP_LINE (FT);
169
170               BEGIN
171                    GET (FT, X);
172                    FAILED ("DATA_ERROR NOT RAISED - (4)");
173               EXCEPTION
174                    WHEN DATA_ERROR =>
175                         NULL;
176                    WHEN OTHERS =>
177                         FAILED ("UNEXPECTED EXCEPTION RAISED - (4)");
178               END;
179
180               IF NOT END_OF_LINE (FT) THEN
181                    FAILED ("END_OF_LINE NOT TRUE AFTER (4)");
182               END IF;
183
184               BEGIN
185                    DELETE (FT);
186               EXCEPTION
187                    WHEN USE_ERROR =>
188                         NULL;
189               END;
190          END;
191     EXCEPTION
192          WHEN INCOMPLETE =>
193               NULL;
194     END;
195
196     RESULT;
197
198END CE3704M;
199