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/] [ce2401c.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CE2401C.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
27
--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
28
--     END_OF_FILE ARE IMPLEMENTED FOR DIRECT FILES WITH
29
--     ELEMENT_TYPE CONSTRAINED ARRAY, AND RECORD WITHOUT DISCRIMINANTS.
30
 
31
-- APPLICABILITY CRITERIA:
32
--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
33
--     DIRECT FILES.
34
 
35
-- HISTORY:
36
--     ABW 08/18/82
37
--     SPS 09/20/82
38
--     SPS 11/09/82
39
--     JBG 05/02/83
40
--     JRK 03/26/84
41
--     EG  05/16/85
42
--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
43
--                   RESULT WHEN FILES ARE NOT SUPPORTED.
44
--     DWC 08/10/87  ISOLATED EXCEPTIONS.
45
 
46
WITH REPORT; USE REPORT;
47
WITH DIRECT_IO;
48
 
49
PROCEDURE CE2401C IS
50
     END_SUBTEST: EXCEPTION;
51
BEGIN
52
 
53
     TEST ("CE2401C" , "CHECK READ, WRITE, SET_INDEX " &
54
                       "INDEX, SIZE, AND END_OF_FILE FOR " &
55
                       "DIRECT FILES FOR CONSTRAINED ARRAY TYPES, " &
56
                       "AND RECORD TYPES WITHOUT DISCRIMINANTS");
57
 
58
     DECLARE
59
          TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN;
60
          PACKAGE DIR_ARR_CN IS NEW DIRECT_IO (ARR_CN);
61
          USE DIR_ARR_CN;
62
          FILE : FILE_TYPE;
63
     BEGIN
64
          BEGIN
65
               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
66
          EXCEPTION
67
               WHEN USE_ERROR | NAME_ERROR =>
68
                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
69
                                    "ON CREATE - CONSTRAINED ARRAY");
70
                    RAISE END_SUBTEST;
71
               WHEN OTHERS =>
72
                    FAILED ("UNEXPECTED ERROR RAISED ON " &
73
                            "CREATE - CONSTRAINED ARRAY");
74
                    RAISE END_SUBTEST;
75
          END;
76
 
77
          DECLARE
78
               ARR : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE);
79
               ITEM : ARR_CN;
80
               ONE : POSITIVE_COUNT := 1;
81
               TWO : POSITIVE_COUNT := 2;
82
          BEGIN
83
               BEGIN
84
                    WRITE (FILE,ARR);
85
               EXCEPTION
86
                    WHEN OTHERS =>
87
                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
88
                                 "CONTRAINED ARRAY - 1");
89
               END;
90
 
91
               BEGIN
92
                    WRITE (FILE,ARR,TWO);
93
               EXCEPTION
94
                    WHEN OTHERS =>
95
                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
96
                                 "CONSTRAINED ARRAY - 2");
97
               END;
98
 
99
               BEGIN
100
                    IF SIZE (FILE) /= TWO THEN
101
                         FAILED ("SIZE FOR TYPE CONSTRAINED ARRAY");
102
                    END IF;
103
                    IF NOT END_OF_FILE (FILE) THEN
104
                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
105
                                 "CONSTRAINED ARRAY");
106
                    END IF;
107
                    SET_INDEX (FILE,ONE);
108
                    IF INDEX (FILE) /= ONE THEN
109
                         FAILED ("WRONG INDEX VALUE FOR TYPE " &
110
                                 "CONSTRAINED ARRAY");
111
                    END IF;
112
               END;
113
 
114
               CLOSE (FILE);
115
 
116
               BEGIN
117
                    OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
118
               EXCEPTION
119
                    WHEN USE_ERROR =>
120
                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
121
                                         "NOT SUPPORTED - 1");
122
                         RAISE END_SUBTEST;
123
               END;
124
 
125
               BEGIN
126
                    READ (FILE,ITEM);
127
                    IF ITEM /= ARR THEN
128
                         FAILED ("INCORRECT ARRAY VALUES READ " &
129
                                 "- 1");
130
                    END IF;
131
               EXCEPTION
132
                    WHEN OTHERS =>
133
                         FAILED ("READ WITHOUT FROM FOR " &
134
                                 "TYPE CONSTRAINED ARRAY");
135
               END;
136
 
137
               BEGIN
138
                    READ (FILE,ITEM,ONE);
139
                    IF ITEM /= ARR THEN
140
                         FAILED ("INCORRECT ARRAY VALUES READ " &
141
                                 "- 2");
142
                    END IF;
143
               EXCEPTION
144
                    WHEN OTHERS =>
145
                         FAILED ("READ WITH FROM FOR " &
146
                                 "TYPE CONSTRAINED ARRAY");
147
               END;
148
          END;
149
 
150
          BEGIN
151
               DELETE (FILE);
152
          EXCEPTION
153
               WHEN USE_ERROR =>
154
                    NULL;
155
          END;
156
 
157
     EXCEPTION
158
          WHEN END_SUBTEST =>
159
               NULL;
160
     END;
161
 
162
     DECLARE
163
          TYPE REC IS
164
               RECORD
165
                    ONE : INTEGER;
166
                    TWO : INTEGER;
167
          END RECORD;
168
          PACKAGE DIR_REC IS NEW DIRECT_IO (REC);
169
          USE DIR_REC;
170
          FILE : FILE_TYPE;
171
     BEGIN
172
          BEGIN
173
               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME(2));
174
          EXCEPTION
175
               WHEN USE_ERROR | NAME_ERROR =>
176
                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
177
                                    "ON CREATE - RECORD");
178
                    RAISE END_SUBTEST;
179
               WHEN OTHERS =>
180
                    FAILED ("UNEXPECTED ERROR RAISED ON CREATE - " &
181
                            "RECORD");
182
          END;
183
 
184
          DECLARE
185
               REC1 : REC := REC'(ONE=>18,TWO=>36);
186
               ITEM : REC;
187
               ONE : POSITIVE_COUNT := 1;
188
               TWO : POSITIVE_COUNT := 2;
189
          BEGIN
190
               BEGIN
191
                    WRITE (FILE,REC1);
192
               EXCEPTION
193
                    WHEN OTHERS =>
194
                         FAILED ("EXCEPTION RAISED ON WRITE FOR - " &
195
                                 "RECORD - 1");
196
               END;
197
 
198
               BEGIN
199
                    WRITE (FILE,REC1,TWO);
200
               EXCEPTION
201
                    WHEN OTHERS =>
202
                         FAILED ("EXCEPTION RAISED ON WRITE FOR - " &
203
                                 "RECORD - 2");
204
               END;
205
 
206
               BEGIN
207
                    IF SIZE (FILE) /= TWO THEN
208
                         FAILED ("SIZE FOR TYPE RECORD");
209
                    END IF;
210
                    IF NOT END_OF_FILE (FILE) THEN
211
                         FAILED ("WRONG END_OF_FILE VALUE FOR RECORD");
212
                    END IF;
213
                    SET_INDEX (FILE,ONE);
214
                    IF INDEX (FILE) /= ONE THEN
215
                         FAILED ("WRONG INDEX VALUE FOR TYPE RECORD");
216
                    END IF;
217
               END;
218
 
219
               CLOSE (FILE);
220
 
221
               BEGIN
222
                    OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
223
               EXCEPTION
224
                    WHEN USE_ERROR =>
225
                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
226
                                         "NOT SUPPORTED - 2");
227
                         RAISE END_SUBTEST;
228
               END;
229
 
230
               BEGIN
231
                    READ (FILE,ITEM);
232
                    IF ITEM /= REC1 THEN
233
                         FAILED ("INCORRECT RECORD VALUES READ " &
234
                                 "- 1");
235
                    END IF;
236
               EXCEPTION
237
                    WHEN OTHERS =>
238
                         FAILED ("READ WITHOUT FROM FOR RECORD");
239
               END;
240
 
241
               BEGIN
242
                    READ (FILE,ITEM,ONE);
243
                    IF ITEM /= REC1 THEN
244
                         FAILED ("INCORRECT RECORD VALUES READ " &
245
                                 "- 2");
246
                    END IF;
247
               EXCEPTION
248
                    WHEN OTHERS =>
249
                         FAILED ("READ WITH FROM FOR " &
250
                                 "TYPE RECORD");
251
               END;
252
          END;
253
 
254
          BEGIN
255
               DELETE (FILE);
256
          EXCEPTION
257
               WHEN USE_ERROR =>
258
                    NULL;
259
          END;
260
 
261
     EXCEPTION
262
          WHEN END_SUBTEST =>
263
               NULL;
264
     END;
265
 
266
     RESULT;
267
 
268
END CE2401C;

powered by: WebSVN 2.1.0

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