Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/ce/ce3809b.ada @ 111:04ced10e8804
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 -- CE3809B.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 -- HISTORY: | |
26 -- CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING. | |
27 -- CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING | |
28 -- OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION | |
29 -- CHARACTERS. CHECK THAT LAST CONTAINS THE INDEX OF THE LAST | |
30 -- CHARACTER READ FROM THE STRING. | |
31 | |
32 -- HISTORY: | |
33 -- SPS 10/07/82 | |
34 -- SPS 12/14/82 | |
35 -- JBG 12/21/82 | |
36 -- DWC 09/15/87 ADDED CASE TO INCLUDE ONLY TABS IN STRING AND | |
37 -- CHECKED THAT END_ERROR IS RAISED. | |
38 | |
39 WITH REPORT; USE REPORT; | |
40 WITH TEXT_IO; USE TEXT_IO; | |
41 | |
42 PROCEDURE CE3809B IS | |
43 BEGIN | |
44 | |
45 TEST ("CE3809B", "CHECK THAT FIXED_IO GET " & | |
46 "OPERATES CORRECTLY ON STRINGS"); | |
47 | |
48 DECLARE | |
49 TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0; | |
50 PACKAGE FXIO IS NEW FIXED_IO (FX); | |
51 USE FXIO; | |
52 X : FX; | |
53 L : POSITIVE; | |
54 STR : STRING (1..10) := " 10.25 "; | |
55 BEGIN | |
56 | |
57 -- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT | |
58 BEGIN | |
59 GET ("896.5 ", X, L); | |
60 IF X /= 896.5 THEN | |
61 FAILED ("FIXED VALUE FROM STRING INCORRECT"); | |
62 END IF; | |
63 EXCEPTION | |
64 WHEN DATA_ERROR => | |
65 FAILED ("DATA_ERROR RAISED - FIXED - 1"); | |
66 WHEN OTHERS => | |
67 FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1"); | |
68 END; | |
69 | |
70 IF L /= IDENT_INT (5) THEN | |
71 FAILED ("VALUE OF LAST INCORRECT - FIXED - 1. " & | |
72 "LAST IS" & INTEGER'IMAGE(L)); | |
73 END IF; | |
74 | |
75 -- STRING LITERAL WITH BLANKS | |
76 BEGIN | |
77 GET (" ", X, L); | |
78 FAILED ("END_ERROR NOT RAISED - FIXED - 2"); | |
79 EXCEPTION | |
80 WHEN END_ERROR => | |
81 IF L /= 5 THEN | |
82 FAILED ("AFTER END_ERROR, VALUE OF LAST " & | |
83 "INCORRECT - 2. LAST IS" & | |
84 INTEGER'IMAGE(L)); | |
85 END IF; | |
86 WHEN DATA_ERROR => | |
87 FAILED ("DATA_ERROR RAISED - FIXED - 2"); | |
88 WHEN OTHERS => | |
89 FAILED ("WRONG EXCEPTION RAISED - FIXED - 2"); | |
90 END; | |
91 | |
92 -- NULL STRING LITERAL | |
93 BEGIN | |
94 GET ("", X, L); | |
95 FAILED ("END_ERROR NOT RAISED - FIXED - 3"); | |
96 EXCEPTION | |
97 WHEN END_ERROR => | |
98 IF L /= 5 THEN | |
99 FAILED ("AFTER END_ERROR, VALUE OF LAST " & | |
100 "INCORRECT - 3. LAST IS" & | |
101 INTEGER'IMAGE(L)); | |
102 END IF; | |
103 WHEN DATA_ERROR => | |
104 FAILED ("DATA_ERROR RAISED - FIXED - 3"); | |
105 WHEN OTHERS => | |
106 FAILED ("WRONG EXCEPTION RAISED - FIXED - 3"); | |
107 END; | |
108 | |
109 -- NULL SLICE | |
110 BEGIN | |
111 GET (STR(5..IDENT_INT(2)), X, L); | |
112 FAILED ("END_ERROR NOT RAISED - FIXED - 4"); | |
113 EXCEPTION | |
114 WHEN END_ERROR => | |
115 IF L /= 5 THEN | |
116 FAILED ("AFTER END_ERROR, VALUE OF LAST " & | |
117 "INCORRECT - 4. LAST IS" & | |
118 INTEGER'IMAGE(L)); | |
119 END IF; | |
120 WHEN DATA_ERROR => | |
121 FAILED ("DATA_ERROR RAISED - FIXED - 4"); | |
122 WHEN OTHERS => | |
123 FAILED ("WRONG EXCEPTION RAISED - FIXED - 4"); | |
124 END; | |
125 | |
126 -- SLICE WITH BLANKS | |
127 BEGIN | |
128 GET (STR(IDENT_INT(9)..10), X, L); | |
129 FAILED ("END_ERROR NOT RAISED - FIXED - 5"); | |
130 EXCEPTION | |
131 WHEN END_ERROR => | |
132 IF L /= IDENT_INT(5) THEN | |
133 FAILED ("AFTER END_ERROR, VALUE OF LAST " & | |
134 "INCORRECT - 5. LAST IS" & | |
135 INTEGER'IMAGE(L)); | |
136 END IF; | |
137 WHEN DATA_ERROR => | |
138 FAILED ("DATA_ERROR RAISED - FIXED - 5"); | |
139 WHEN OTHERS => | |
140 FAILED ("WRONG EXCEPTION RAISED - FIXED - 5"); | |
141 END; | |
142 | |
143 -- NON-NULL SLICE | |
144 BEGIN | |
145 GET (STR(2..IDENT_INT(8)), X, L); | |
146 IF X /= 10.25 THEN | |
147 FAILED ("FIXED VALUE INCORRECT - 6"); | |
148 END IF; | |
149 IF L /= 8 THEN | |
150 FAILED ("LAST INCORRECT FOR SLICE - 6. " & | |
151 "LAST IS" & INTEGER'IMAGE(L)); | |
152 END IF; | |
153 EXCEPTION | |
154 WHEN OTHERS => | |
155 FAILED ("EXCEPTION RAISED - 6"); | |
156 END; | |
157 | |
158 -- LEFT-JUSTIFIED, POSITIVE EXPONENT | |
159 BEGIN | |
160 GET ("1.34E+02", X, L); | |
161 IF X /= 134.0 THEN | |
162 FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7"); | |
163 END IF; | |
164 | |
165 IF L /= 8 THEN | |
166 FAILED ("VALUE OF LAST INCORRECT - FIXED - 7. " & | |
167 "LAST IS" & INTEGER'IMAGE(L)); | |
168 END IF; | |
169 EXCEPTION | |
170 WHEN DATA_ERROR => | |
171 FAILED ("DATA_EROR RAISED - FIXED - 7"); | |
172 WHEN OTHERS => | |
173 FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7"); | |
174 END; | |
175 | |
176 -- RIGHT-JUSTIFIED, NEGATIVE EXPONENT | |
177 BEGIN | |
178 GET (" 25.0E-2", X, L); | |
179 IF X /= 0.25 THEN | |
180 FAILED ("NEG EXPONENT INCORRECT - 8"); | |
181 END IF; | |
182 IF L /= 8 THEN | |
183 FAILED ("LAST INCORRECT - 8. " & | |
184 "LAST IS" & INTEGER'IMAGE(L)); | |
185 END IF; | |
186 EXCEPTION | |
187 WHEN OTHERS => | |
188 FAILED ("EXCEPTION RAISED - 8"); | |
189 END; | |
190 | |
191 -- RIGHT-JUSTIFIED, NEGATIVE | |
192 GET (" -1.50", X, L); | |
193 IF X /= -1.5 THEN | |
194 FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9"); | |
195 END IF; | |
196 IF L /= 7 THEN | |
197 FAILED ("LAST INCORRECT - 9. " & | |
198 "LAST IS" & INTEGER'IMAGE(L)); | |
199 END IF; | |
200 | |
201 -- HORIZONTAL TAB WITH BLANK | |
202 BEGIN | |
203 GET (" " & ASCII.HT & "2.3E+2", X, L); | |
204 IF X /= 230.0 THEN | |
205 FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10"); | |
206 END IF; | |
207 IF L /= 8 THEN | |
208 FAILED ("LAST INCORRECT FOR TAB - 10. " & | |
209 "LAST IS" & INTEGER'IMAGE(L)); | |
210 END IF; | |
211 EXCEPTION | |
212 WHEN DATA_ERROR => | |
213 FAILED ("DATA_ERROR FOR STRING WITH TAB - 10"); | |
214 WHEN OTHERS => | |
215 FAILED ("EXCEPTION FOR STRING WITH TAB - 10"); | |
216 END; | |
217 | |
218 -- HORIZONTAL TABS ONLY | |
219 | |
220 BEGIN | |
221 GET (ASCII.HT & ASCII.HT, X, L); | |
222 FAILED ("END_ERROR NOT RAISED - FIXED - 11"); | |
223 EXCEPTION | |
224 WHEN END_ERROR => | |
225 IF L /= IDENT_INT(8) THEN | |
226 FAILED ("AFTER END_ERROR, VALUE OF LAST " & | |
227 "INCORRECT - 11. LAST IS" & | |
228 INTEGER'IMAGE(L)); | |
229 END IF; | |
230 WHEN DATA_ERROR => | |
231 FAILED ("DATA_ERROR RAISED - FIXED - 11"); | |
232 WHEN OTHERS => | |
233 FAILED ("WRONG EXCEPTION RAISED - FIXED - 11"); | |
234 END; | |
235 END; | |
236 | |
237 RESULT; | |
238 | |
239 END CE3809B; |