Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ce/ce3411c.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 -- CE3411C.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 COL OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
27 -- NO FILE IS SPECIFIED. CHECK THAT COL CAN OPERATE ON FILES OF
28 -- MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
29 -- INPUT_FILE.
30
31 -- APPLICABILITY CRITERIA:
32 -- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
33 -- TEXT FILES.
34
35 -- HISTORY:
36 -- SPS 09/29/82
37 -- JBG 01/31/83
38 -- JBG 08/30/83
39 -- JLH 09/02/87 REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
40 -- CODE, AND CHECKED FOR USE_ERROR ON DELETE.
41
42 WITH REPORT;
43 USE REPORT;
44 WITH TEXT_IO;
45 USE TEXT_IO;
46
47 PROCEDURE CE3411C IS
48 INCOMPLETE : EXCEPTION;
49
50 BEGIN
51
52 TEST ("CE3411C", "CHECK THAT COL OPERATES ON DEFAULT IN_FILE AND "&
53 "OUT_FILE FILES");
54
55 DECLARE
56 F1, F2 : FILE_TYPE;
57 C : POSITIVE_COUNT;
58 X : CHARACTER;
59 BEGIN
60 IF COL /= COL (STANDARD_OUTPUT) THEN
61 FAILED ("COL DEFAULT NOT STANDARD_OUTPUT");
62 END IF;
63
64 IF COL /= COL (STANDARD_INPUT) THEN
65 FAILED ("COL DEFAULT NOT STANDARD_INPUT");
66 END IF;
67
68 IF COL /= COL (CURRENT_INPUT) THEN
69 FAILED ("COL DEFAULT NOT CURRENT_INPUT");
70 END IF;
71
72 IF COL /= COL (CURRENT_OUTPUT) THEN
73 FAILED ("COL DEFAULT NOT CURRENT_OUTPUT");
74 END IF;
75
76 BEGIN
77 CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
78 EXCEPTION
79 WHEN USE_ERROR =>
80 NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
81 "OUT_FILE MODE");
82 RAISE INCOMPLETE;
83 WHEN NAME_ERROR =>
84 NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
85 "WITH OUT_FILE MODE");
86 RAISE INCOMPLETE;
87 END;
88
89 CREATE (F2, OUT_FILE);
90
91 SET_OUTPUT (F2);
92
93 PUT (F1, "STRING");
94 IF COL (F1) /= 7 THEN
95 FAILED ("COL INCORRECT SUBTEST 1");
96 END IF;
97
98 PUT (F2, "OUTPUT STRING");
99 IF COL /= COL(F2) AND COL(F2) /= 14 THEN
100 FAILED ("COL INCORRECT SUBTEST 2; WAS " &
101 COUNT'IMAGE(COL) & " VS. " &
102 COUNT'IMAGE(COL(F2)));
103 END IF;
104
105 CLOSE (F1);
106
107 BEGIN
108 OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
109 EXCEPTION
110 WHEN USE_ERROR =>
111 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
112 "WITH IN_FILE MODE");
113 RAISE INCOMPLETE;
114 END;
115
116 SET_INPUT (F1);
117
118 GET (F1, X);
119 GET (F1, X);
120 GET (F1, X);
121
122 IF X /= 'R' THEN
123 FAILED ("INCORRECT VALUE READ");
124 END IF;
125
126 IF COL (CURRENT_INPUT) /= 4 AND COL /= 4 THEN
127 FAILED ("COL INCORRECT SUBTEST 3");
128 END IF;
129
130 BEGIN
131 DELETE (F1);
132 EXCEPTION
133 WHEN USE_ERROR =>
134 NULL;
135 END;
136
137 CLOSE (F2);
138
139 EXCEPTION
140 WHEN INCOMPLETE =>
141 NULL;
142 END;
143
144 RESULT;
145
146 END CE3411C;