1-- CE3804J.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 FIXED_IO GET OPERATES ON IN_FILE FILE AND WHEN
27--     NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED.
28
29-- APPLICABILITY CRITERIA:
30--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
31--     SUPPORT TEXT FILES.
32
33-- HISTORY:
34--     DWC 09/14/87  CREATED ORIGINAL TEST.
35--     JRL 02/28/96  Changed upper bound of type FX from 1000.0 to 250.0.
36--                   Corrected TEST string.
37
38WITH REPORT;
39USE REPORT;
40WITH TEXT_IO;
41USE TEXT_IO;
42
43PROCEDURE CE3804J IS
44     INCOMPLETE : EXCEPTION;
45
46BEGIN
47
48     TEST ("CE3804J", "CHECK THAT FIXED_IO GET OPERATES ON " &
49                      "IN_FILE FILE AND WHEN NO FILE IS " &
50                      "SPECIFIED THE CURRENT DEFAULT INPUT " &
51                      "FILE IS USED");
52
53     DECLARE
54          FT1, FT2 : FILE_TYPE;
55     BEGIN
56
57-- CREATE AND INITIALIZE FILES
58
59          BEGIN
60               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
61          EXCEPTION
62               WHEN USE_ERROR =>
63                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
64                                    "CREATE WITH OUT_FILE MODE - 1");
65                    RAISE INCOMPLETE;
66               WHEN NAME_ERROR =>
67                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
68                                    "CREATE WITH OUT_FILE MODE - 1");
69                    RAISE INCOMPLETE;
70          END;
71
72          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
73
74          PUT (FT1, "1.0");
75          NEW_LINE (FT1);
76
77          CLOSE (FT1);
78
79          BEGIN
80               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
81          EXCEPTION
82               WHEN USE_ERROR =>
83                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
84                                    "FOR IN_FILE MODE");
85                    RAISE INCOMPLETE;
86          END;
87
88          PUT (FT2, "2.0");
89          NEW_LINE (FT2);
90
91          CLOSE (FT2);
92          OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
93
94          SET_INPUT (FT2);
95
96          DECLARE
97               TYPE FX IS DELTA 0.0001 RANGE 1.0 .. 250.0;
98               PACKAGE FXIO IS NEW FIXED_IO (FX);
99               USE FXIO;
100               X : FX;
101          BEGIN
102               BEGIN
103                    GET (FT1, X);
104                    IF X /= 1.0 THEN
105                         FAILED ("FIXED FILE VALUE INCORRECT");
106                    END IF;
107               EXCEPTION
108                    WHEN OTHERS =>
109                         FAILED ("EXCEPTION RAISED - FILE FIXED");
110               END;
111
112               BEGIN
113                    GET (X);
114                    IF X /= 2.0 THEN
115                         FAILED ("FIXED DEFAULT VALUE INCORRECT");
116                    END IF;
117               EXCEPTION
118                    WHEN OTHERS =>
119                         FAILED ("EXCEPTION RAISED - DEFAULT FIXED");
120               END;
121          END;
122
123          BEGIN
124               DELETE (FT1);
125               DELETE (FT2);
126          EXCEPTION
127               WHEN USE_ERROR =>
128                    NULL;
129          END;
130     EXCEPTION
131          WHEN INCOMPLETE =>
132               NULL;
133     END;
134
135     RESULT;
136
137END CE3804J;
138