Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxa4034.a @ 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 -- CXA4034.A
2 --
3 -- Grant of Unlimited Rights
4 --
5 -- The Ada Conformity Assessment Authority (ACAA) holds unlimited
6 -- rights in the software and documentation contained herein. Unlimited
7 -- rights are the same as those granted by the U.S. Government for older
8 -- parts of the Ada Conformity Assessment Test Suite, and are defined
9 -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
10 -- intends to confer upon all recipients unlimited rights equal to those
11 -- held by the ACAA. These rights include rights to use, duplicate,
12 -- release or disclose the released technical data and computer software
13 -- in whole or in part, in any manner and for any purpose whatsoever, and
14 -- to have or permit others 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 --
26 -- OBJECTIVE:
27 -- Check that Ada.Strings.Bounded.Slice raises Index_Error if
28 -- High > Length (Source) or Low > Length (Source) + 1.
29 -- (Defect Report 8652/0049).
30 --
31 -- Check that Ada.Strings.Wide_Bounded.Slice raises Index_Error if
32 -- High > Length (Source) or Low > Length (Source) + 1.
33 --
34 -- CHANGE HISTORY:
35 -- 12 FEB 2001 PHL Initial version
36 -- 14 MAR 2001 RLB Added Wide_Bounded subtest.
37 --
38 --!
39 with Ada.Exceptions;
40 use Ada.Exceptions;
41 with Ada.Strings.Bounded;
42 with Ada.Strings.Wide_Bounded;
43 use Ada.Strings;
44 with Report;
45 use Report;
46 procedure CXA4034 is
47
48 package Bs is new Ada.Strings.Bounded.Generic_Bounded_Length (40);
49
50 package WBs is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length (32);
51
52 Source : String (Ident_Int (1) .. Ident_Int (30));
53
54 Wide_Source : Wide_String (Ident_Int (1) .. Ident_Int (24));
55
56 X : Bs.Bounded_String;
57
58 WX : WBs.Bounded_Wide_String;
59
60 begin
61 Test ("CXA4034",
62 "Check that Slice raises Index_Error if either Low or High is " &
63 "greater than the Length(Source) for Ada.Strings.Bounded and " &
64 "Ada.Strings.Wide_Bounded");
65
66 -- Fill Source with "ABC..."
67 for I in Source'Range loop
68 Source (I) := Ident_Char (Character'Val (I +
69 Character'Pos ('A') - Source'First));
70 end loop;
71 -- and W with "ABC..."
72 for I in Wide_Source'Range loop
73 Wide_Source (I) := Ident_Wide_Char (Wide_Character'Val (I +
74 Wide_Character'Pos ('A') - Wide_Source'First));
75 end loop;
76
77 X := Bs.To_Bounded_String (Source);
78
79 begin
80 declare
81 S : constant String :=
82 Bs.Slice (X, Low => Ident_Int (28), High => Ident_Int (41));
83 begin
84 Failed ("No exception raised by Slice - 1");
85 if S = Source then
86 Comment ("Don't optimize S");
87 end if;
88 end;
89 exception
90 when Index_Error =>
91 null; -- Expected exception.
92 when E: others =>
93 Failed ("Exception raised - " & Exception_Name (E) &
94 " - " & Exception_Message (E) & " - 1");
95 end;
96
97 begin
98 declare
99 S : constant String :=
100 Bs.Slice (X, Low => Ident_Int (8), High => Ident_Int (31));
101 begin
102 Failed ("No exception raised by Slice - 2");
103 if S = Source then
104 Comment ("Don't optimize S");
105 end if;
106 end;
107 exception
108 when Index_Error =>
109 null; -- Expected exception.
110 when E: others =>
111 Failed ("Exception raised - " & Exception_Name (E) &
112 " - " & Exception_Message (E) & " - 2");
113 end;
114
115 begin
116 declare
117 S : constant String :=
118 Bs.Slice (X, Low => Ident_Int (15), High => Ident_Int (30));
119 begin
120 if S /= Source(15..30) then
121 Failed ("Wrong result - 3");
122 end if;
123 end;
124 exception
125 when E: others =>
126 Failed ("Exception raised - " & Exception_Name (E) &
127 " - " & Exception_Message (E) & " - 3");
128 end;
129
130 begin
131 declare
132 S : constant String :=
133 Bs.Slice (X, Low => Ident_Int (42), High => Ident_Int (28));
134 begin
135 Failed ("No exception raised by Slice - 4");
136 if S = Source then
137 Comment ("Don't optimize S");
138 end if;
139 end;
140 exception
141 when Index_Error =>
142 null; -- Expected exception.
143 when E: others =>
144 Failed ("Exception raised - " & Exception_Name (E) &
145 " - " & Exception_Message (E) & " - 4");
146 end;
147
148 begin
149 declare
150 S : constant String :=
151 Bs.Slice (X, Low => Ident_Int (31), High => Ident_Int (28));
152 begin
153 if S /= "" then
154 Failed ("Wrong result - 5");
155 end if;
156 end;
157 exception
158 when E: others =>
159 Failed ("Exception raised - " & Exception_Name (E) &
160 " - " & Exception_Message (E) & " - 5");
161 end;
162
163 begin
164 declare
165 S : constant String :=
166 Bs.Slice (X, Low => Ident_Int (30), High => Ident_Int (30));
167 begin
168 if S /= Source(30..30) then
169 Failed ("Wrong result - 6");
170 end if;
171 end;
172 exception
173 when E: others =>
174 Failed ("Exception raised - " & Exception_Name (E) &
175 " - " & Exception_Message (E) & " - 6");
176 end;
177
178 WX := WBs.To_Bounded_Wide_String (Wide_Source);
179
180 begin
181 declare
182 W : constant Wide_String :=
183 WBs.Slice (WX, Low => Ident_Int (21), High => Ident_Int (33));
184 begin
185 Failed ("No exception raised by Slice - 7");
186 if W = Wide_Source then
187 Comment ("Don't optimize W");
188 end if;
189 end;
190 exception
191 when Index_Error =>
192 null; -- Expected exception.
193 when E: others =>
194 Failed ("Exception raised - " & Exception_Name (E) &
195 " - " & Exception_Message (E) & " - 7");
196 end;
197
198 begin
199 declare
200 W : constant Wide_String :=
201 WBs.Slice (WX, Low => Ident_Int (8), High => Ident_Int (25));
202 begin
203 Failed ("No exception raised by Slice - 8");
204 if W = Wide_Source then
205 Comment ("Don't optimize W");
206 end if;
207 end;
208 exception
209 when Index_Error =>
210 null; -- Expected exception.
211 when E: others =>
212 Failed ("Exception raised - " & Exception_Name (E) &
213 " - " & Exception_Message (E) & " - 8");
214 end;
215
216 begin
217 declare
218 W : constant Wide_String :=
219 WBs.Slice (WX, Low => Ident_Int (15), High => Ident_Int (24));
220 begin
221 if W /= Wide_Source(15..24) then
222 Failed ("Wrong result - 8");
223 end if;
224 end;
225 exception
226 when E: others =>
227 Failed ("Exception raised - " & Exception_Name (E) &
228 " - " & Exception_Message (E) & " - 9");
229 end;
230
231 begin
232 declare
233 W : constant Wide_String :=
234 WBs.Slice (WX, Low => Ident_Int (36), High => Ident_Int (20));
235 begin
236 Failed ("No exception raised by Slice - 10");
237 if W = Wide_Source then
238 Comment ("Don't optimize W");
239 end if;
240 end;
241 exception
242 when Index_Error =>
243 null; -- Expected exception.
244 when E: others =>
245 Failed ("Exception raised - " & Exception_Name (E) &
246 " - " & Exception_Message (E) & " - 10");
247 end;
248
249 begin
250 declare
251 W : constant Wide_String :=
252 WBs.Slice (WX, Low => Ident_Int (25), High => Ident_Int (21));
253 begin
254 if W /= "" then
255 Failed ("Wrong result - 11");
256 end if;
257 end;
258 exception
259 when E: others =>
260 Failed ("Exception raised - " & Exception_Name (E) &
261 " - " & Exception_Message (E) & " - 11");
262 end;
263
264 begin
265 declare
266 W : constant Wide_String :=
267 WBs.Slice (WX, Low => Ident_Int (24), High => Ident_Int (24));
268 begin
269 if W /= Wide_Source(24..24) then
270 Failed ("Wrong result - 12");
271 end if;
272 end;
273 exception
274 when E: others =>
275 Failed ("Exception raised - " & Exception_Name (E) &
276 " - " & Exception_Message (E) & " - 12");
277 end;
278
279 Result;
280 end CXA4034;
281