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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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
 
45
WITH REPORT; USE REPORT;
46
WITH DIRECT_IO;
47
 
48
PROCEDURE CE2401A IS
49
     END_SUBTEST : EXCEPTION;
50
BEGIN
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
 
357
END CE2401A;

powered by: WebSVN 2.1.0

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