OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ce/] [ce3603a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CE3603A.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 END_ERROR IS NOT RAISED BY:
27
--       GET FOR CHARACTERS UNTIL ONLY LINE AND PAGE TERMINATORS REMAIN;
28
--       GET FROM STRING UNTIL FEWER CHARACTERS THAN NEEDED REMAIN;
29
--       GET_LINE UNTIL THE FINAL PAGE TERMINATOR HAS BEEN SKIPPED.
30
 
31
-- APPLICABILITY CRITERIA:
32
--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
33
--     TEXT FILES.
34
 
35
-- HISTORY:
36
--     SPS 08/31/82
37
--     JBG 12/23/82
38
--     EG  05/22/85
39
--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
40
--                   RESULT WHEN FILES ARE NOT SUPPORTED.
41
--     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND REMOVED
42
--                   DEPENDENCE ON RESET.
43
 
44
 
45
WITH REPORT; USE REPORT;
46
WITH TEXT_IO; USE TEXT_IO;
47
 
48
PROCEDURE CE3603A IS
49
     INCOMPLETE : EXCEPTION;
50
 
51
BEGIN
52
 
53
     TEST ("CE3603A", "CHECK THAT END_ERROR IS RAISED BY GET AFTER " &
54
                      "THE LAST CHARACTER IN THE FILE HAS BEEN READ");
55
 
56
     DECLARE
57
          FILE1 : FILE_TYPE;
58
          OLDCH, CH : CHARACTER;
59
          ST        : STRING (1..10) := (1..10 => '.');
60
          COUNT     : NATURAL;
61
     BEGIN
62
 
63
          BEGIN
64
               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
65
          EXCEPTION
66
               WHEN USE_ERROR =>
67
                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
68
                                    "WITH OUT_FILE MODE");
69
                    RAISE INCOMPLETE;
70
               WHEN NAME_ERROR =>
71
                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
72
                                    "CREATE WITH OUT_FILE MODE");
73
                    RAISE INCOMPLETE;
74
               WHEN OTHERS =>
75
                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT" &
76
                            "CREATE");
77
                    RAISE INCOMPLETE;
78
          END;
79
 
80
          PUT (FILE1, "LINE ONE");
81
          NEW_LINE (FILE1);
82
          PUT (FILE1, "LINE TWO");
83
          NEW_LINE (FILE1, 3);
84
          NEW_PAGE (FILE1);
85
          NEW_PAGE (FILE1);
86
          CLOSE (FILE1);
87
 
88
          BEGIN
89
 
90
               BEGIN
91
                    OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
92
               EXCEPTION
93
                    WHEN USE_ERROR =>
94
                         NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
95
                                         "OPEN WITH IN_FILE MODE");
96
                         RAISE INCOMPLETE;
97
               END;
98
 
99
               SKIP_LINE (FILE1);
100
               GET (FILE1, ST(1..7));
101
               IF ST(1..7) /= "LINE TW" THEN
102
                    FAILED ("NOT POSITIONED RIGHT - GET CHAR");
103
               END IF;
104
 
105
-- COUNT NUMBER OF CHARACTERS IN FIRST LINE (TO ALLOW FOR TRAILING
106
--     BLANKS)
107
 
108
               COUNT := 0;
109
               WHILE NOT END_OF_LINE(FILE1)
110
               LOOP
111
                    GET (FILE1, CH);
112
                    OLDCH := CH;
113
                    COUNT := COUNT + 1;
114
               END LOOP;
115
 
116
               BEGIN
117
                    GET (FILE1, CH);
118
                    FAILED ("END_ERROR NOT RAISED - GET " &
119
                            "CHARACTER");
120
               EXCEPTION
121
                    WHEN END_ERROR =>
122
                         IF CH /= OLDCH THEN
123
                              FAILED ("CH MODIFIED ON END_" &
124
                                      "ERROR");
125
                         END IF;
126
                    WHEN OTHERS =>
127
                         FAILED ("WRONG EXCEPTION RAISED " &
128
                                 "- GET CHARACTER");
129
               END;
130
 
131
               CLOSE (FILE1);
132
 
133
               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
134
 
135
               SKIP_LINE (FILE1);
136
               GET (FILE1, ST(1..7));
137
               IF ST(1..7) /= "LINE TW" THEN
138
                    FAILED ("WRONG LINE 2. ACTUALLY READ '" & ST(1..7) &
139
                            "'");
140
               END IF;
141
 
142
               BEGIN
143
                    GET (FILE1, ST(8..8+COUNT));
144
                    FAILED ("END_ERROR NOT RAISED - GET " &
145
                            "STRING");
146
               EXCEPTION
147
                    WHEN END_ERROR =>
148
                         IF ST(1..7) /= "LINE TW" THEN
149
                              FAILED ("ST MODIFIED ON END_ERROR");
150
                         END IF;
151
                    WHEN OTHERS =>
152
                         FAILED ("WRONG EXCEPTION RAISED " &
153
                                 "- GET STRING");
154
               END;
155
 
156
               CLOSE (FILE1);
157
 
158
          END;
159
 
160
          DECLARE
161
               LAST : NATURAL;
162
          BEGIN
163
 
164
               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
165
 
166
               SKIP_LINE (FILE1);
167
               GET_LINE (FILE1, ST, LAST);
168
               IF LAST < 8 THEN
169
                    FAILED ("LAST < 8.  LAST IS" & INTEGER'IMAGE(LAST));
170
               ELSIF ST(1..8) /= "LINE TWO" THEN
171
                    FAILED ("GET_LINE FAILED. ACTUALLY READ '" &
172
                            ST(1..8) & "'");
173
               END IF;
174
 
175
               SKIP_PAGE (FILE1);
176
               SKIP_PAGE (FILE1);
177
 
178
               BEGIN
179
                    GET_LINE (FILE1, ST(1..1), LAST);
180
                    FAILED ("END_ERROR NOT RAISED - GET_LINE - 1");
181
               EXCEPTION
182
                    WHEN END_ERROR =>
183
                         IF LAST /= 8 THEN
184
                              FAILED ("LAST MODIFIED BY GET_LINE " &
185
                                      "ON END_ERROR.  LAST IS" &
186
                                      INTEGER'IMAGE(LAST));
187
                         END IF;
188
                    WHEN OTHERS =>
189
                         FAILED ("WRONG EXCEPTION - GET_LINE - 1");
190
               END;
191
 
192
               BEGIN     -- NULL ITEM ARGUMENT
193
                    GET_LINE (FILE1, ST(1..0), LAST);
194
               EXCEPTION
195
                    WHEN END_ERROR =>
196
                         FAILED ("GET_LINE ATTEMPTED TO READ INTO A " &
197
                                 "NULL STRING");
198
                    WHEN OTHERS =>
199
                         FAILED ("WRONG EXCEPTION - GET_LINE - 2");
200
               END;
201
          END;
202
 
203
          BEGIN
204
               DELETE (FILE1);
205
          EXCEPTION
206
               WHEN USE_ERROR =>
207
                    NULL;
208
          END;
209
 
210
     EXCEPTION
211
          WHEN INCOMPLETE =>
212
               NULL;
213
     END;
214
 
215
     RESULT;
216
 
217
END CE3603A;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.