Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ce/ce2401e.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- CE2401E.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_TYPE
29 -- FLOATING POINT.
30
31 -- APPLICABILITY CRITERIA:
32 -- THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF
33 -- DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES
34 -- WITH IN_FILE MODE.
35
36 -- HISTORY:
37 -- ABW 08/18/82
38 -- SPS 09/15/82
39 -- SPS 11/11/82
40 -- JBG 05/02/83
41 -- EG 11/19/85 HANDLE IMPLEMENTATIONS WITH
42 -- POSITIVE_COUNT'LAST=1.
43 -- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE
44 -- RESULT WHEN FILES ARE NOT SUPPORTED.
45 -- DWC 08/10/87 ISOLATED EXCEPTIONS. SPLIT FIXED POINT TESTS
46 -- INTO CE2401I.
47
48 WITH REPORT; USE REPORT;
49 WITH DIRECT_IO;
50
51 PROCEDURE CE2401E IS
52
53 END_SUBTEST : EXCEPTION;
54
55 BEGIN
56
57 TEST ("CE2401E", "CHECK THAT READ, WRITE, SET_INDEX, " &
58 "INDEX, SIZE, AND END_OF_FILE ARE " &
59 "SUPPORTED FOR DIRECT FILES WITH " &
60 "ELEMENT_TYPE FLOAT");
61
62 DECLARE
63
64 PACKAGE DIR_FLT IS NEW DIRECT_IO (FLOAT);
65 USE DIR_FLT;
66 FILE_FLT : FILE_TYPE;
67
68 BEGIN
69 BEGIN
70 CREATE (FILE_FLT, INOUT_FILE, LEGAL_FILE_NAME);
71 EXCEPTION
72 WHEN USE_ERROR | NAME_ERROR =>
73 NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
74 "ON CREATE - FLOAT");
75 RAISE END_SUBTEST;
76 WHEN OTHERS =>
77 FAILED ("UNEXPECTED ERROR RAISED ON " &
78 "CREATE - FLOAT");
79 RAISE END_SUBTEST;
80 END;
81
82 DECLARE
83 FLT : FLOAT := 65.0;
84 ITEM_FLT : FLOAT;
85 ONE_FLT : POSITIVE_COUNT := 1;
86 TWO_FLT : POSITIVE_COUNT := 2;
87 BEGIN
88 BEGIN
89 WRITE (FILE_FLT, FLT);
90 EXCEPTION
91 WHEN OTHERS =>
92 FAILED ("EXCEPTION RAISED ON WRITE FOR " &
93 "FLOATING POINT - 1");
94 END;
95
96 BEGIN
97 WRITE (FILE_FLT, FLT, TWO_FLT);
98 EXCEPTION
99 WHEN OTHERS =>
100 FAILED ("EXCEPTION RAISED ON WRITE FOR " &
101 "FLOATING POINT - 2");
102 END;
103
104 BEGIN
105 IF SIZE (FILE_FLT) /= TWO_FLT THEN
106 FAILED ("SIZE FOR FLOATING POINT");
107 END IF;
108
109 IF NOT END_OF_FILE (FILE_FLT) THEN
110 FAILED ("WRONG END_OF_FILE VALUE FOR " &
111 "FLOATING POINT");
112 END IF;
113
114 SET_INDEX (FILE_FLT, ONE_FLT);
115 IF INDEX (FILE_FLT) /= ONE_FLT THEN
116 FAILED ("WRONG INDEX VALUE FOR " &
117 "FLOATING POINT");
118 END IF;
119 END;
120
121 CLOSE (FILE_FLT);
122
123 BEGIN
124 OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME);
125 EXCEPTION
126 WHEN USE_ERROR =>
127 NOT_APPLICABLE ("OPEN FOR IN_FILE " &
128 "MODE NOT SUPPORTED");
129 RAISE END_SUBTEST;
130 END;
131
132 BEGIN
133 READ (FILE_FLT, ITEM_FLT);
134 IF ITEM_FLT /= FLT THEN
135 FAILED ("WRONG VALUE READ FOR " &
136 "FLOATING POINT");
137 END IF;
138 EXCEPTION
139 WHEN OTHERS =>
140 FAILED ("READ WITHOUT FROM FOR " &
141 "TYPE FLOATING POINT");
142 END;
143
144 BEGIN
145 READ (FILE_FLT, ITEM_FLT, ONE_FLT);
146 IF ITEM_FLT /= FLT THEN
147 FAILED ("WRONG VALUE READ WITH INDEX FOR " &
148 "FLOATING POINT");
149 END IF;
150 EXCEPTION
151 WHEN OTHERS =>
152 FAILED ("READ WITH FROM FOR " &
153 "TYPE FLOATING POINT");
154 END;
155
156 BEGIN
157 DELETE (FILE_FLT);
158 EXCEPTION
159 WHEN USE_ERROR =>
160 NULL;
161 END;
162 END;
163
164 EXCEPTION
165 WHEN END_SUBTEST =>
166 NULL;
167 END;
168
169
170 RESULT;
171
172 END CE2401E;