1-- CE3704E.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 INTEGER_IO GET RAISES DATA_ERROR WHEN THE LEXICAL
27--     ELEMENT IS NOT OF THE INTEGER TYPE EXPECTED.  CHECK THAT ITEM
28--     IS UNAFFECTED AND READING CAN CONTINUE AFTER THE EXCEPTION
29--     HAS BEEN HANDLED.
30
31-- APPLICABILITY CRITERIA:
32--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
33--     SUPPORT TEXT FILES.
34
35-- HISTORY:
36--     SPS 10/04/82
37--     VKG 01/14/83
38--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
39--                   RESULT WHEN FILES ARE NOT SUPPORTED.
40--     DWC 09/10/87  REMOVED UNNECCESSARY CODE, CORRECTED EXCEPTION
41--                   HANDLING, AND CHECKED FOR USE_ERROR ON DELETE.
42
43WITH REPORT; USE REPORT;
44WITH TEXT_IO; USE TEXT_IO;
45
46PROCEDURE CE3704E IS
47     INCOMPLETE : EXCEPTION;
48
49BEGIN
50
51     TEST ("CE3704E", "CHECK THAT INTEGER_IO GET RAISES DATA_ERROR " &
52                      "WHEN THE LEXICAL ELEMENT IS NOT OF THE " &
53                      "INTEGER TYPE EXPECTED.  CHECK THAT ITEM " &
54                      "IS UNAFFECTED AND READING CAN CONTINUE AFTER " &
55                      "THE EXCEPTION HAS BEEN HANDLED");
56
57     DECLARE
58          FT : FILE_TYPE;
59          TYPE INT IS NEW INTEGER RANGE 10 .. 20;
60          PACKAGE IIO IS NEW INTEGER_IO (INT);
61          USE IIO;
62          X : INT := 16;
63     BEGIN
64
65-- CREATE AND INITIALIZE FILE
66
67          BEGIN
68               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
69          EXCEPTION
70               WHEN USE_ERROR =>
71                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
72                                    "WITH OUT_FILE MODE");
73                    RAISE INCOMPLETE;
74               WHEN NAME_ERROR =>
75                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
76                                    "WITH OUT_FILE MODE");
77                    RAISE INCOMPLETE;
78          END;
79
80          PUT (FT, " 101 12");
81          CLOSE(FT);
82
83          BEGIN
84               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
85          EXCEPTION
86               WHEN USE_ERROR =>
87                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
88                                    "WITH IN_FILE MODE");
89                    RAISE INCOMPLETE;
90          END;
91
92          BEGIN
93               GET (FT, X, 2);
94               FAILED ("DATA_ERROR NOT RAISED - 1");
95          EXCEPTION
96               WHEN DATA_ERROR =>
97                    IF X /= 16 THEN
98                         FAILED ("ITEM AFFECTED BY GET WHEN DATA" &
99                                 "_ERROR IS RAISED");
100                    END IF;
101               WHEN OTHERS =>
102                    FAILED ("WRONG EXCEPTION RAISED - 1");
103          END;
104
105          BEGIN
106               GET (FT, X, 3);
107               FAILED ("DATA_ERROR NOT RAISED - 2");
108          EXCEPTION
109               WHEN DATA_ERROR =>
110                    IF X /= 16 THEN
111                         FAILED ("ITEM AFFECTED BY GET WHEN DATA" &
112                                 "_ERROR IS RAISED");
113                    END IF;
114               WHEN OTHERS =>
115                    FAILED ("WRONG EXCEPTION RAISED - 2");
116          END;
117
118          BEGIN
119               GET (FT, X, 2);
120               IF X /= 12 THEN
121                    FAILED ("READING NOT CONTINUED CORRECTLY " &
122                            "AFTER EXCEPTION");
123               END IF;
124          EXCEPTION
125               WHEN OTHERS =>
126                    FAILED ("GET OF CORRECT DATA RAISED EXCEPTION");
127          END;
128
129          BEGIN
130               DELETE (FT);
131          EXCEPTION
132               WHEN USE_ERROR =>
133                    NULL;
134          END;
135
136     EXCEPTION
137          WHEN INCOMPLETE =>
138               NULL;
139     END;
140
141     RESULT;
142
143END CE3704E;
144