Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ce/ce3705d.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 -- CE3705D.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 DATA_ERROR, NOT END_ERROR, IS RAISED WHEN WIDTH > 0,
27 -- FEWER THAN WIDTH CHARACTERS REMAIN IN THE FILE, A BASED LITERAL
28 -- IS BEING READ, AND THE CLOSING # OR : HAS NOT YET BEEN FOUND.
29
30 -- APPLICABILITY CRITERIA:
31 -- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
32 -- TEXT FILES.
33
34 -- HISTORY:
35 -- JLH 07/19/88 CREATED ORIGINAL TEST.
36
37 WITH REPORT; USE REPORT;
38 WITH TEXT_IO; USE TEXT_IO;
39
40 PROCEDURE CE3705D IS
41
42 PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
43 USE IIO;
44
45 FILE : FILE_TYPE;
46 ITEM : INTEGER;
47 INCOMPLETE : EXCEPTION;
48
49 BEGIN
50
51 TEST ("CE3705D", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " &
52 "RAISED WHEN WIDTH > 0, FEWER THAN WIDTH " &
53 "CHARACTERS REMAIN IN THE FILE, A BASED " &
54 "LITERAL IS BEING READ, AND THE CLOSING # " &
55 "OR : HAS NOT YET BEEN FOUND");
56
57 BEGIN
58
59 BEGIN
60 CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
61 EXCEPTION
62 WHEN USE_ERROR =>
63 NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
64 "WITH MODE OUT_FILE");
65 RAISE INCOMPLETE;
66 WHEN NAME_ERROR =>
67 NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
68 "WITH MODE OUT_FILE");
69 RAISE INCOMPLETE;
70 WHEN OTHERS =>
71 FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
72 RAISE INCOMPLETE;
73 END;
74
75 PUT (FILE, "2#1111_1111#");
76 NEW_LINE (FILE);
77 PUT (FILE, "16#FFF");
78
79 CLOSE (FILE);
80
81 BEGIN
82 OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
83 EXCEPTION
84 WHEN USE_ERROR =>
85 NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " &
86 "WITH MODE IN_FILE");
87 RAISE INCOMPLETE;
88 WHEN OTHERS =>
89 FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
90 RAISE INCOMPLETE;
91 END;
92
93 GET (FILE, ITEM);
94 IF ITEM /= 255 THEN
95 FAILED ("INCORRECT VALUE READ");
96 END IF;
97
98 BEGIN
99 GET (FILE, ITEM, WIDTH => 7);
100 FAILED ("DATA_ERROR NOT RAISED");
101 EXCEPTION
102 WHEN END_ERROR =>
103 FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED");
104 WHEN DATA_ERROR =>
105 NULL;
106 WHEN OTHERS =>
107 FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
108 END;
109
110 BEGIN
111 DELETE (FILE);
112 EXCEPTION
113 WHEN USE_ERROR =>
114 NULL;
115 END;
116
117 EXCEPTION
118 WHEN INCOMPLETE =>
119 NULL;
120 END;
121
122 RESULT;
123
124 END CE3705D;