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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ce/] [ce3115a.ada] - Blame information for rev 399

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CE3115A.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 RESETTING ONE OF A MULTIPLE OF INTERNAL FILES
27
--     ASSOCIATED WITH THE SAME EXTERNAL FILE HAS NO EFFECT ON ANY
28
--     OF THE OTHER INTERNAL FILES.
29
 
30
 
31
-- APPLICABILITY CRITERIA:
32
--     THIS TEST APPLIES ONLY TO IMPLEMENTATIONS WHICH SUPPORT MULTIPLE
33
--     INTERNAL FILES ASSOCIATED WITH THE SAME EXTERNAL FILE AND
34
--     RESETTING OF THESE MULTIPLE INTERNAL FILES FOR TEXT FILES.
35
 
36
-- HISTORY:
37
--     DLD 08/16/82
38
--     SPS 11/09/82
39
--     JBG 06/04/84
40
--     EG  11/19/85  MADE TEST INAPPLICABLE IF CREATE USE_ERROR.
41
--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE RESULT WHEN
42
--                   FILES NOT SUPPORTED.
43
--     GMT 08/25/87  COMPLETELY REVISED.
44
--     EDS 12/01/97  ADD NAME_ERROR HANDLER TO OUTPUT NOT_APPLICABLE RESULT.
45
--     RLB 09/29/98  MADE MODIFICATION TO AVOID BUFFERING PROBLEMS.
46
 
47
WITH REPORT; USE REPORT;
48
WITH TEXT_IO; USE TEXT_IO;
49
 
50
PROCEDURE CE3115A IS
51
 
52
BEGIN
53
 
54
     TEST ("CE3115A", "CHECK THAT RESETTING ONE OF A MULTIPLE OF " &
55
                      "INTERNAL FILES ASSOCIATED WITH THE SAME " &
56
                      "EXTERNAL FILE HAS NO EFFECT ON ANY OF THE " &
57
                      "OTHER INTERNAL FILES");
58
 
59
     DECLARE
60
          TXT_FILE_ONE : TEXT_IO.FILE_TYPE;
61
          TXT_FILE_TWO : TEXT_IO.FILE_TYPE;
62
 
63
          CH           : CHARACTER := 'A';
64
 
65
          INCOMPLETE   : EXCEPTION;
66
 
67
          PROCEDURE TXT_CLEANUP IS
68
               FILE1_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_ONE);
69
               FILE2_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_TWO);
70
          BEGIN
71
               IF FILE1_OPEN AND FILE2_OPEN THEN
72
                    CLOSE (TXT_FILE_TWO);
73
                    DELETE (TXT_FILE_ONE);
74
               ELSIF FILE1_OPEN THEN
75
                    DELETE (TXT_FILE_ONE);
76
               ELSIF FILE2_OPEN THEN
77
                    DELETE (TXT_FILE_TWO);
78
               END IF;
79
          EXCEPTION
80
               WHEN TEXT_IO.USE_ERROR =>
81
                    NULL;
82
               WHEN OTHERS =>
83
                    FAILED ("UNEXPECTED EXCEPTION RAISED " &
84
                            "IN CLEANUP - 1");
85
          END TXT_CLEANUP;
86
 
87
     BEGIN
88
 
89
          BEGIN -- CREATE FIRST FILE
90
 
91
               CREATE (TXT_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
92
               PUT (TXT_FILE_ONE, CH);
93
 
94
          EXCEPTION
95
               WHEN TEXT_IO.USE_ERROR =>
96
                    NOT_APPLICABLE ("USE_ERROR RAISED; CREATE OF " &
97
                                    "EXTERNAL FILENAME IS NOT " &
98
                                    "SUPPORTED - 2");
99
                    RAISE INCOMPLETE;
100
               WHEN TEXT_IO.NAME_ERROR =>
101
                    NOT_APPLICABLE ("NAME_ERROR RAISED; CREATE OF " &
102
                                    "EXTERNAL FILENAME IS NOT " &
103
                                    "SUPPORTED - 3");
104
                    RAISE INCOMPLETE;
105
 
106
          END; -- CREATE FIRST FILE
107
 
108
          BEGIN -- OPEN SECOND FILE
109
 
110
               OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
111
 
112
          EXCEPTION
113
 
114
               WHEN TEXT_IO.USE_ERROR =>
115
                    NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " &
116
                                    "SUPPORTED WHEN ONE IS MODE " &
117
                                    "OUT_FILE AND THE OTHER IS MODE " &
118
                                    "IN_FILE - 4" &
119
                                    " - USE_ERROR RAISED ");
120
                    TXT_CLEANUP;
121
                    RAISE INCOMPLETE;
122
 
123
               WHEN TEXT_IO.NAME_ERROR =>
124
                    NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " &
125
                                    "SUPPORTED WHEN ONE IS MODE " &
126
                                    "OUT_FILE AND THE OTHER IS MODE " &
127
                                    "IN_FILE - 4" &
128
                                    " - NAME_ERROR RAISED ");
129
                    TXT_CLEANUP;
130
                    RAISE INCOMPLETE;
131
 
132
          END; -- OPEN SECOND FILE
133
          FLUSH (TXT_FILE_ONE); -- AVOID BUFFERING PROBLEMS.
134
 
135
          CH := 'B';
136
          GET (TXT_FILE_TWO, CH);
137
          IF CH /= 'A' THEN
138
               FAILED ("INCORRECT VALUE FOR GET - 5");
139
          END IF;
140
 
141
          BEGIN -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING
142
 
143
               RESET (TXT_FILE_ONE);
144
               IF MODE (TXT_FILE_ONE) /= OUT_FILE THEN
145
                    FAILED ("FILE WAS NOT RESET - 6");
146
               END IF;
147
               IF MODE (TXT_FILE_TWO) /= IN_FILE THEN
148
                    FAILED ("RESETTING OF ONE INTERNAL FILE " &
149
                            "AFFECTED THE OTHER INTERNAL FILE - 7");
150
               END IF;
151
 
152
          EXCEPTION
153
 
154
               WHEN TEXT_IO.USE_ERROR =>
155
                    NOT_APPLICABLE ("RESETTING OF EXTERNAL FILE FOR " &
156
                                    "OUT_FILE MODE IS " &
157
                                    " NOT SUPPORTED - 8");
158
                    TXT_CLEANUP;
159
                    RAISE INCOMPLETE;
160
 
161
          END; -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING
162
 
163
          -- PERFORM SOME I/O ON THE FIRST FILE
164
 
165
          PUT (TXT_FILE_ONE, 'C');
166
          PUT (TXT_FILE_ONE, 'D');
167
          PUT (TXT_FILE_ONE, 'E');
168
          CLOSE (TXT_FILE_ONE);
169
 
170
          BEGIN
171
               OPEN (TXT_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
172
          EXCEPTION
173
               WHEN USE_ERROR =>
174
                    NOT_APPLICABLE ("MULTIPLE INTERNAL FILES NOT " &
175
                                    "SUPPORTED WHEN BOTH FILES HAVE " &
176
                                    "IN_FILE MODE - 9");
177
                    RAISE INCOMPLETE;
178
          END;
179
 
180
          GET (TXT_FILE_ONE, CH);
181
          GET (TXT_FILE_ONE, CH);
182
 
183
          BEGIN -- INITIALIZE SECOND FILE AND PERFORM SOME I/O
184
 
185
               CLOSE (TXT_FILE_TWO);
186
               OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
187
 
188
          EXCEPTION
189
 
190
               WHEN TEXT_IO.USE_ERROR =>
191
                    FAILED ("MULTIPLE INTERNAL FILES SHOULD STILL " &
192
                            "BE ALLOWED - 10");
193
                    TXT_CLEANUP;
194
                    RAISE INCOMPLETE;
195
 
196
          END; -- INITIALIZE SECOND FILE AND PERFORM SOME I/O
197
 
198
          BEGIN -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE
199
 
200
               GET (TXT_FILE_TWO, CH);
201
               IF CH /= 'C' THEN
202
                    FAILED ("INCORRECT VALUE FOR GET OPERATION - 11");
203
               END IF;
204
 
205
               RESET (TXT_FILE_ONE);
206
               GET (TXT_FILE_TWO, CH);
207
               IF CH /= 'D' THEN
208
                    FAILED ("RESETTING INDEX OF ONE TEXT FILE " &
209
                            "RESETS THE OTHER ASSOCIATED FILE - 12");
210
               END IF;
211
 
212
          EXCEPTION
213
 
214
               WHEN TEXT_IO.USE_ERROR =>
215
                    FAILED ("RESETTING SHOULD STILL BE SUPPORTED - 13");
216
                    TXT_CLEANUP;
217
                    RAISE INCOMPLETE;
218
 
219
          END; -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE
220
 
221
          TXT_CLEANUP;
222
 
223
     EXCEPTION
224
 
225
          WHEN INCOMPLETE =>
226
               NULL;
227
 
228
     END;
229
 
230
     RESULT;
231
 
232
END CE3115A;

powered by: WebSVN 2.1.0

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