1-- CE2401K.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 DATA CAN BE OVERWRITTEN IN THE DIRECT FILE AND
27--     THE CORRECT VALUES CAN LATER BE READ.
28
29-- APPLICABILITY CRITERIA:
30--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
31--     CREATION OF INOUT_FILE MODE AND OPENING OF OUT_FILE MODE FOR
32--     DIRECT FILES.
33
34-- HISTORY:
35--     DWC 08/12/87  CREATED ORIGINAL TEST.
36
37WITH REPORT; USE REPORT;
38WITH DIRECT_IO;
39
40PROCEDURE CE2401K IS
41     END_SUBTEST: EXCEPTION;
42BEGIN
43
44     TEST ("CE2401K" , "CHECK THAT DATA CAN BE OVERWRITTEN IN " &
45                       "THE DIRECT FILE AND THE CORRECT VALUES " &
46                       "CAN LATER BE READ.");
47
48     DECLARE
49          PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
50          USE DIR_IO;
51          FILE : FILE_TYPE;
52     BEGIN
53          BEGIN
54               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
55          EXCEPTION
56               WHEN USE_ERROR | NAME_ERROR =>
57                    NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
58                                    "NOT SUPPORTED");
59                    RAISE END_SUBTEST;
60               WHEN OTHERS =>
61                    FAILED ("UNEXPECTED ERROR RAISED ON " &
62                            "CREATE");
63                    RAISE END_SUBTEST;
64          END;
65
66          DECLARE
67               OUT_ITEM1 : INTEGER := 10;
68               OUT_ITEM2 : INTEGER := 21;
69               IN_ITEM   : INTEGER;
70               ONE : POSITIVE_COUNT := 1;
71               TWO : POSITIVE_COUNT := 2;
72          BEGIN
73               BEGIN
74                    WRITE (FILE, OUT_ITEM1, ONE);
75                    WRITE (FILE, OUT_ITEM2, TWO);
76                    WRITE (FILE, OUT_ITEM2, ONE);
77               EXCEPTION
78                    WHEN OTHERS =>
79                         FAILED ("EXCEPTION RAISED ON WRITE " &
80                                 "IN INOUT_FILE MODE");
81                         RAISE END_SUBTEST;
82               END;
83
84               BEGIN
85                    READ (FILE, IN_ITEM, ONE);
86                    IF OUT_ITEM2 /= IN_ITEM THEN
87                         FAILED ("INCORRECT INTEGER VALUE READ - 1");
88                         RAISE END_SUBTEST;
89                    END IF;
90               END;
91
92               BEGIN
93                    READ (FILE, IN_ITEM, TWO);
94                    IF OUT_ITEM2 /= IN_ITEM THEN
95                         FAILED ("INCORRECT INTEGER VALUE READ - 2");
96                         RAISE END_SUBTEST;
97                    END IF;
98               END;
99
100               CLOSE (FILE);
101
102               BEGIN
103                    OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
104               EXCEPTION
105                    WHEN USE_ERROR =>
106                         RAISE END_SUBTEST;
107               END;
108
109               BEGIN
110                    WRITE (FILE, OUT_ITEM1, ONE);
111                    WRITE (FILE, OUT_ITEM2, TWO);
112                    WRITE (FILE, OUT_ITEM1, TWO);
113               EXCEPTION
114                    WHEN OTHERS =>
115                         FAILED ("EXCEPTION RAISED ON WRITE " &
116                                 "IN OUT_FILE MODE");
117                         RAISE END_SUBTEST;
118               END;
119
120               BEGIN
121                    RESET (FILE, IN_FILE);
122               EXCEPTION
123                    WHEN USE_ERROR =>
124                         RAISE END_SUBTEST;
125               END;
126
127               BEGIN
128                    READ (FILE, IN_ITEM, ONE);
129                    IF OUT_ITEM1 /= IN_ITEM THEN
130                         FAILED ("INCORRECT INTEGER VALUE READ - 3");
131                         RAISE END_SUBTEST;
132                    END IF;
133               EXCEPTION
134                    WHEN USE_ERROR =>
135                         FAILED ("READ IN IN_FILE MODE - 1");
136               END;
137
138               BEGIN
139                    READ (FILE, IN_ITEM, TWO);
140                    IF OUT_ITEM1 /= IN_ITEM THEN
141                         FAILED ("INCORRECT INTEGER VALUE READ - 4");
142                         RAISE END_SUBTEST;
143                    END IF;
144               EXCEPTION
145                    WHEN USE_ERROR =>
146                         FAILED ("READ IN IN_FILE MODE - 2");
147               END;
148          END;
149
150          BEGIN
151               DELETE (FILE);
152          EXCEPTION
153               WHEN USE_ERROR =>
154                    NULL;
155          END;
156
157     EXCEPTION
158          WHEN END_SUBTEST =>
159               NULL;
160     END;
161
162     RESULT;
163
164END CE2401K;
165