1-- CE2401A.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
27--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE AND
28--     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPES
29--     STRING, CHARACTER, AND INTEGER.
30
31-- APPLICABILITY CRITERIA:
32--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
33--     SUPPORT DIRECT FILES.
34
35-- HISTORY:
36--     ABW 08/16/82
37--     SPS 09/15/82
38--     SPS 11/09/82
39--     JBG 02/22/84  CHANGE TO .ADA TEST.
40--     EG  05/16/85
41--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
42--                   RESULT WHEN FILES ARE NOT SUPPORTED.
43--     DWC 07/31/87  ISOLATED EXCEPTIONS.
44
45WITH REPORT; USE REPORT;
46WITH DIRECT_IO;
47
48PROCEDURE CE2401A IS
49     END_SUBTEST : EXCEPTION;
50BEGIN
51
52     TEST ("CE2401A" , "CHECK THAT READ, WRITE, SET_INDEX " &
53                       "INDEX, SIZE AND END_OF_FILE ARE " &
54                       "SUPPORTED FOR DIRECT FILES");
55
56     DECLARE
57          SUBTYPE STR_TYPE IS STRING (1..12);
58          PACKAGE DIR_STR IS NEW DIRECT_IO (STR_TYPE);
59          USE DIR_STR;
60          FILE_STR : FILE_TYPE;
61     BEGIN
62          BEGIN
63               CREATE (FILE_STR, INOUT_FILE, LEGAL_FILE_NAME);
64          EXCEPTION
65               WHEN USE_ERROR | NAME_ERROR =>
66                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
67                                    "ON CREATE - STRING");
68                    RAISE END_SUBTEST;
69               WHEN OTHERS =>
70                    FAILED ("UNEXPECTED ERROR RAISED ON " &
71                            "CREATE - STRING");
72                    RAISE END_SUBTEST;
73          END;
74
75          DECLARE
76               STR : STR_TYPE := "TEXT OF FILE";
77               ITEM_STR : STR_TYPE;
78               ONE_STR : POSITIVE_COUNT := 1;
79               TWO_STR : POSITIVE_COUNT := 2;
80          BEGIN
81               BEGIN
82                    WRITE (FILE_STR,STR);
83               EXCEPTION
84                    WHEN OTHERS =>
85                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
86                                 "STRING - 1");
87               END;
88
89               BEGIN
90                    WRITE (FILE_STR,STR,TWO_STR);
91               EXCEPTION
92                    WHEN OTHERS =>
93                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
94                                 "STRING - 2");
95               END;
96
97               BEGIN
98                    IF SIZE (FILE_STR) /= TWO_STR THEN
99                         FAILED ("SIZE FOR TYPE STRING");
100                    END IF;
101                    IF NOT END_OF_FILE (FILE_STR) THEN
102                         FAILED ("WRONG END_OF_FILE VALUE FOR STRING");
103                    END IF;
104                    SET_INDEX (FILE_STR,ONE_STR);
105                    IF INDEX (FILE_STR) /= ONE_STR THEN
106                         FAILED ("WRONG INDEX VALUE FOR STRING");
107                    END IF;
108               END;
109
110               CLOSE (FILE_STR);
111
112               BEGIN
113                    OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME);
114               EXCEPTION
115                    WHEN USE_ERROR =>
116                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
117                                         "NOT SUPPORTED - 1");
118                         RAISE END_SUBTEST;
119               END;
120
121               BEGIN
122                    READ (FILE_STR,ITEM_STR);
123                    IF ITEM_STR /= STR THEN
124                         FAILED ("INCORRECT STRING VALUE READ - 1");
125                    END IF;
126               EXCEPTION
127                    WHEN OTHERS =>
128                         FAILED ("READ WITHOUT FROM FOR STRING");
129               END;
130
131               BEGIN
132                    READ (FILE_STR,ITEM_STR,ONE_STR);
133                    IF ITEM_STR /= STR THEN
134                         FAILED ("INCORRECT STRING VALUE READ - 2");
135                    END IF;
136               EXCEPTION
137                    WHEN OTHERS =>
138                         FAILED ("READ WITH FROM FOR STRING");
139               END;
140          END;
141
142          BEGIN
143               DELETE (FILE_STR);
144          EXCEPTION
145               WHEN USE_ERROR =>
146                    NULL;
147          END;
148
149     EXCEPTION
150          WHEN END_SUBTEST =>
151               NULL;
152     END;
153
154     DECLARE
155          PACKAGE DIR_CHR IS NEW DIRECT_IO (CHARACTER);
156          USE DIR_CHR;
157          FILE_CHR : FILE_TYPE;
158     BEGIN
159          BEGIN
160               CREATE (FILE_CHR, INOUT_FILE, LEGAL_FILE_NAME(2));
161          EXCEPTION
162               WHEN USE_ERROR | NAME_ERROR =>
163                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
164                                    "ON CREATE - CHARACTER");
165                    RAISE END_SUBTEST;
166               WHEN OTHERS =>
167                    FAILED ("UNEXPECTED ERROR RAISED ON " &
168                            "CREATE - CHARACTER");
169                    RAISE END_SUBTEST;
170          END;
171
172          DECLARE
173               CHR : CHARACTER := 'C';
174               ITEM_CHR : CHARACTER;
175               ONE_CHR : POSITIVE_COUNT := 1;
176               TWO_CHR : POSITIVE_COUNT := 2;
177          BEGIN
178               BEGIN
179                    WRITE (FILE_CHR,CHR);
180               EXCEPTION
181                    WHEN OTHERS =>
182                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
183                                 "CHARACTER - 1");
184               END;
185
186               BEGIN
187                    WRITE (FILE_CHR,CHR,TWO_CHR);
188               EXCEPTION
189                    WHEN OTHERS =>
190                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
191                                 "CHARACTER - 2");
192               END;
193
194               BEGIN
195                    IF SIZE (FILE_CHR) /= TWO_CHR THEN
196                         FAILED ("SIZE FOR TYPE CHARACTER");
197                    END IF;
198                    IF NOT END_OF_FILE (FILE_CHR) THEN
199                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
200                                 "CHARACTER");
201                    END IF;
202                    SET_INDEX (FILE_CHR,ONE_CHR);
203                    IF INDEX (FILE_CHR) /= ONE_CHR THEN
204                         FAILED ("WRONG INDEX VALUE FOR TYPE " &
205                                 "CHARACTER");
206                    END IF;
207               END;
208
209               CLOSE (FILE_CHR);
210
211               BEGIN
212                    OPEN (FILE_CHR, IN_FILE, LEGAL_FILE_NAME(2));
213               EXCEPTION
214                    WHEN USE_ERROR =>
215                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
216                                         "NOT SUPPORTED - 2");
217                         RAISE END_SUBTEST;
218               END;
219
220               BEGIN
221                    READ (FILE_CHR,ITEM_CHR);
222                    IF ITEM_CHR /= CHR THEN
223                         FAILED ("INCORRECT CHR VALUE READ - 1");
224                    END IF;
225               EXCEPTION
226                    WHEN OTHERS =>
227                         FAILED ("READ WITHOUT FROM FOR " &
228                                 "TYPE CHARACTER");
229               END;
230
231               BEGIN
232                    READ (FILE_CHR,ITEM_CHR,ONE_CHR);
233                    IF ITEM_CHR /= CHR THEN
234                         FAILED ("INCORRECT CHR VALUE READ - 2");
235                    END IF;
236               EXCEPTION
237                    WHEN OTHERS =>
238                         FAILED ("READ WITH FROM FOR " &
239                                 "TYPE CHARACTER");
240               END;
241          END;
242
243          BEGIN
244               DELETE (FILE_CHR);
245          EXCEPTION
246               WHEN USE_ERROR =>
247                    NULL;
248          END;
249
250     EXCEPTION
251          WHEN END_SUBTEST =>
252               NULL;
253     END;
254
255     DECLARE
256          PACKAGE DIR_INT IS NEW DIRECT_IO (INTEGER);
257          USE DIR_INT;
258          FILE_INT : FILE_TYPE;
259     BEGIN
260          BEGIN
261               CREATE (FILE_INT, INOUT_FILE, LEGAL_FILE_NAME(3));
262          EXCEPTION
263               WHEN USE_ERROR | NAME_ERROR =>
264                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
265                                    "ON CREATE - INTEGER");
266                    RAISE END_SUBTEST;
267               WHEN OTHERS =>
268                    FAILED ("UNEXPECTED ERROR RAISED ON " &
269                            "CREATE - INTEGER");
270                    RAISE END_SUBTEST;
271          END;
272
273          DECLARE
274               INT : INTEGER := IDENT_INT (33);
275               ITEM_INT : INTEGER;
276               ONE_INT : POSITIVE_COUNT := 1;
277               TWO_INT : POSITIVE_COUNT := 2;
278          BEGIN
279               BEGIN
280                    WRITE (FILE_INT,INT);
281               EXCEPTION
282                    WHEN OTHERS =>
283                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
284                                 "INTEGER - 1");
285               END;
286
287               BEGIN
288                    WRITE (FILE_INT,INT,TWO_INT);
289               EXCEPTION
290                    WHEN OTHERS =>
291                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
292                                 "INTEGER - 2");
293               END;
294
295               BEGIN
296                    IF SIZE (FILE_INT) /= TWO_INT THEN
297                         FAILED ("SIZE FOR TYPE INTEGER");
298                    END IF;
299                    IF NOT END_OF_FILE (FILE_INT) THEN
300                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
301                                 "INTEGER");
302                    END IF;
303                    SET_INDEX (FILE_INT, ONE_INT);
304                    IF INDEX (FILE_INT) /= ONE_INT THEN
305                         FAILED ("WRONG INDEX VALUE FOR TYPE INTEGER");
306                    END IF;
307               END;
308
309               CLOSE (FILE_INT);
310
311               BEGIN
312                    OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME(3));
313               EXCEPTION
314                    WHEN USE_ERROR =>
315                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
316                                         "NOT SUPPORTED - 3");
317                         RAISE END_SUBTEST;
318               END;
319
320               BEGIN
321                    READ (FILE_INT,ITEM_INT);
322                    IF ITEM_INT /= INT THEN
323                         FAILED ("INCORRECT INT VALUE READ - 1");
324                    END IF;
325               EXCEPTION
326                    WHEN OTHERS =>
327                         FAILED ("READ WITHOUT FROM FOR " &
328                                 "TYPE INTEGER");
329               END;
330
331               BEGIN
332                    READ (FILE_INT,ITEM_INT,ONE_INT);
333                    IF ITEM_INT /= INT THEN
334                         FAILED ("INCORRECT INT VALUE READ - 2");
335                    END IF;
336               EXCEPTION
337                    WHEN OTHERS =>
338                         FAILED ("READ WITH FROM FOR " &
339                                 "TYPE INTEGER");
340               END;
341          END;
342
343          BEGIN
344               DELETE (FILE_INT);
345          EXCEPTION
346               WHEN USE_ERROR =>
347                    NULL;
348          END;
349
350     EXCEPTION
351          WHEN END_SUBTEST =>
352               NULL;
353     END;
354
355     RESULT;
356
357END CE2401A;
358