Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ce/ce3602d.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 -- CE3602D.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 FILES ARE OF MODE IN_FILE AND THAT WHEN NO FILE IS
27 -- SPECIFIED THAT CURRENT DEFAULT INPUT FILE IS USED.
28
29 -- APPLICABILITY CRITERIA:
30 -- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
31 -- TEXT FILES.
32
33 -- HISTORY:
34 -- SPS 10/06/82
35 -- SPS 12/17/82
36 -- JBG 02/22/84 CHANGED TO .ADA TEST
37 -- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE
38 -- RESULT WHEN FILES ARE NOT SUPPORTED.
39 -- JLH 09/08/87 REMOVED DEPENDENCE ON RESET AND CORRECTED
40 -- EXCEPTION HANDLING.
41
42
43 WITH REPORT;
44 USE REPORT;
45 WITH TEXT_IO;
46 USE TEXT_IO;
47
48 PROCEDURE CE3602D IS
49 INCOMPLETE : EXCEPTION;
50
51 BEGIN
52
53 TEST ("CE3602D", "CHECK THAT GET FOR STRINGS AND CHARACTERS " &
54 "OPERATES ON IN_FILE FILES");
55
56 DECLARE
57 FT , FILE : FILE_TYPE;
58 X : CHARACTER;
59 ST: STRING (1 .. 3);
60 BEGIN
61
62 -- CREATE AND INITIALIZE FILES
63
64 BEGIN
65 CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
66 EXCEPTION
67 WHEN USE_ERROR =>
68 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
69 "WITH OUT_FILE MODE");
70 RAISE INCOMPLETE;
71 WHEN NAME_ERROR =>
72 NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
73 "CREATE WITH OUT_FILE MODE");
74 RAISE INCOMPLETE;
75 WHEN OTHERS =>
76 FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
77 "CREATE");
78 RAISE INCOMPLETE;
79 END;
80
81 PUT (FT, "ABCE");
82 NEW_LINE (FT);
83 PUT (FT, "EFGHIJKLM");
84
85 CLOSE (FT);
86
87 BEGIN
88 OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
89 EXCEPTION
90 WHEN USE_ERROR =>
91 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
92 "WITH IN_FILE MODE - 1");
93 RAISE INCOMPLETE;
94 END;
95
96 CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2));
97
98 PUT (FILE, "STRING");
99 NEW_LINE (FILE);
100 PUT (FILE, "END OF OUTPUT");
101
102 CLOSE (FILE);
103
104 OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
105
106 SET_INPUT (FILE);
107
108 -- BEGIN TEST
109
110 GET (FT, X);
111 IF X /= IDENT_CHAR ('A') THEN
112 FAILED ("CHARACTER FROM FILE INCORRECT, WAS '" &
113 X & "'");
114 END IF;
115
116 GET (FT, ST);
117 IF ST /= "BCE" THEN
118 FAILED ("STRING FROM FILE INCORRECT; WAS """ &
119 ST & """");
120 END IF;
121
122 GET (X);
123 IF X /= IDENT_CHAR ('S') THEN
124 FAILED ("CHARACTER FROM DEFAULT INCORRECT; WAS '" &
125 X & "'");
126 END IF;
127
128 GET (ST);
129 IF ST /= "TRI" THEN
130 FAILED ("STRING FROM DEFAULT INCORRECT; WAS """ &
131 ST & """");
132 END IF;
133
134 BEGIN
135 DELETE (FT);
136 DELETE (FILE);
137 EXCEPTION
138 WHEN USE_ERROR =>
139 NULL;
140 END;
141
142 EXCEPTION
143 WHEN INCOMPLETE =>
144 NULL;
145
146 END;
147
148 RESULT;
149
150 END CE3602D;