Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb30041.am @ 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 -- CXB30041.AM
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 --
26 -- OBJECTIVE:
27 -- Check that the functions To_C and To_Ada map between the Ada type
28 -- Character and the C type char.
29 --
30 -- Check that the function Is_Nul_Terminated returns True if the
31 -- char_array parameter contains nul, and otherwise False.
32 --
33 -- Check that the function To_C produces a correct char_array result,
34 -- with lower bound of 0, and length dependent upon the Item and
35 -- Append_Nul parameters.
36 --
37 -- Check that the function To_Ada produces a correct string result, with
38 -- lower bound of 1, and length dependent upon the Item and Trim_Nul
39 -- parameters.
40 --
41 -- Check that the function To_Ada raises Terminator_Error if the
42 -- parameter Trim_Nul is set to True, but the actual Item parameter
43 -- does not contain the nul char.
44 --
45 -- TEST DESCRIPTION:
46 -- This test uses a variety of Character, char, String, and char_array
47 -- objects to test versions of the To_C, To_Ada, and Is_Nul_Terminated
48 -- functions.
49 --
50 -- This test assumes that the following characters are all included
51 -- in the implementation defined type Interfaces.C.char:
52 -- ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
53 --
54 -- APPLICABILITY CRITERIA:
55 -- This test is applicable to all implementations that provide
56 -- package Interfaces.C. If an implementation provides
57 -- package Interfaces.C, this test must compile, execute, and
58 -- report "PASSED".
59 --
60 -- SPECIAL REQUIREMENTS:
61 -- The file CXB30040.C must be compiled with a C compiler.
62 -- Implementation dialects of C may require alteration of
63 -- the C program syntax (see individual C files).
64 --
65 -- Note that the compiled C code must be bound with the compiled Ada
66 -- code to create an executable image. An implementation must provide
67 -- the necessary commands to accomplish this.
68 --
69 -- Note that the C code included in CXB30040.C conforms
70 -- to ANSI-C. Modifications to these files may be required for other
71 -- C compilers. An implementation must provide the necessary
72 -- modifications to satisfy the function requirements.
73 --
74 -- TEST FILES:
75 -- The following files comprise this test:
76 --
77 -- CXB30040.C
78 -- CXB30041.AM
79 --
80 -- CHANGE HISTORY:
81 -- 30 Aug 95 SAIC Initial prerelease version.
82 -- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
83 -- 26 Oct 96 SAIC Incorporated reviewer comments.
84 -- 13 Sep 99 RLB Replaced (bogus) Unchecked_Conversions with a
85 -- C function character generator.
86 --
87 --!
88
89 with Report;
90 with Interfaces.C; -- N/A => ERROR
91 with Ada.Characters.Latin_1;
92 with Ada.Exceptions;
93 with Ada.Strings.Fixed;
94 with Impdef;
95
96 procedure CXB30041 is
97 begin
98
99 Report.Test ("CXB3004", "Check that the functions To_C and To_Ada " &
100 "produce correct results");
101
102 Test_Block:
103 declare
104
105 use Interfaces, Interfaces.C;
106 use Ada.Characters, Ada.Characters.Latin_1;
107 use Ada.Exceptions;
108 use Ada.Strings.Fixed;
109
110 Start_Character,
111 Stop_Character,
112 TC_Character : Character := Character'First;
113 TC_char,
114 TC_Low_char,
115 TC_High_char : char := char'First;
116 TC_String : String(1..8) := (others => Latin_1.NUL);
117 TC_char_array : char_array(0..7) := (others => C.nul);
118
119 -- The function Char_Gen returns a character corresponding to its
120 -- argument.
121 -- Value 0 .. 9 ==> '0' .. '9'
122 -- Value 10 .. 19 ==> 'A' .. 'J'
123 -- Value 20 .. 29 ==> 'k' .. 't'
124 -- Value 30 ==> ' '
125 -- Value 31 ==> '.'
126 -- Value 32 ==> ','
127
128 function Char_Gen (Value : in int) return char;
129
130 -- Use the user-defined C function char_gen as a completion to the
131 -- function specification above.
132
133 pragma Import (Convention => C,
134 Entity => Char_Gen,
135 External_Name => Impdef.CXB30040_External_Name);
136
137 begin
138
139 -- Check that the functions To_C and To_Ada map between the Ada type
140 -- Character and the C type char.
141
142 if To_C(Ada.Characters.Latin_1.NUL) /= Interfaces.C.nul then
143 Report.Failed("Incorrect result from To_C with NUL character input");
144 end if;
145
146 Start_Character := Report.Ident_Char('k');
147 Stop_Character := Report.Ident_Char('t');
148 for TC_Character in Start_Character..Stop_Character loop
149 if To_C(Item => TC_Character) /=
150 Char_Gen(Character'Pos(TC_Character) - Character'Pos('k') + 20) then
151 Report.Failed("Incorrect result from To_C with lower case " &
152 "alphabetic character input");
153 end if;
154 end loop;
155
156 Start_Character := Report.Ident_Char('A');
157 Stop_Character := Report.Ident_Char('J');
158 for TC_Character in Start_Character..Stop_Character loop
159 if To_C(Item => TC_Character) /=
160 Char_Gen(Character'Pos(TC_Character) - Character'Pos('A') + 10) then
161 Report.Failed("Incorrect result from To_C with upper case " &
162 "alphabetic character input");
163 end if;
164 end loop;
165
166 Start_Character := Report.Ident_Char('0');
167 Stop_Character := Report.Ident_Char('9');
168 for TC_Character in Start_Character..Stop_Character loop
169 if To_C(Item => TC_Character) /=
170 Char_Gen(Character'Pos(TC_Character) - Character'Pos('0')) then
171 Report.Failed("Incorrect result from To_C with digit " &
172 "character input");
173 end if;
174 end loop;
175 if To_C(Item => ' ') /= Char_Gen(30) then
176 Report.Failed("Incorrect result from To_C with space " &
177 "character input");
178 end if;
179 if To_C(Item => '.') /= Char_Gen(31) then
180 Report.Failed("Incorrect result from To_C with dot " &
181 "character input");
182 end if;
183 if To_C(Item => ',') /= Char_Gen(32) then
184 Report.Failed("Incorrect result from To_C with comma " &
185 "character input");
186 end if;
187
188 if To_Ada(Interfaces.C.nul) /= Ada.Characters.Latin_1.NUL then
189 Report.Failed("Incorrect result from To_Ada with nul char input");
190 end if;
191
192 for Code in int range
193 int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
194 -- 'k' .. 't'
195 if To_Ada(Item => Char_Gen(Code)) /=
196 Character'Val (Character'Pos('k') + (Code - 20)) then
197 Report.Failed("Incorrect result from To_Ada with lower case " &
198 "alphabetic char input");
199 end if;
200 end loop;
201
202 for Code in int range
203 int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
204 -- 'A' .. 'J'
205 if To_Ada(Item => Char_Gen(Code)) /=
206 Character'Val (Character'Pos('A') + (Code - 10)) then
207 Report.Failed("Incorrect result from To_Ada with upper case " &
208 "alphabetic char input");
209 end if;
210 end loop;
211
212 for Code in int range
213 int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
214 -- '0' .. '9'
215 if To_Ada(Item => Char_Gen(Code)) /=
216 Character'Val (Character'Pos('0') + (Code)) then
217 Report.Failed("Incorrect result from To_Ada with digit " &
218 "char input");
219 end if;
220 end loop;
221
222 if To_Ada(Item => Char_Gen(30)) /= ' ' then
223 Report.Failed("Incorrect result from To_Ada with space " &
224 "char input");
225 end if;
226 if To_Ada(Item => Char_Gen(31)) /= '.' then
227 Report.Failed("Incorrect result from To_Ada with dot " &
228 "char input");
229 end if;
230 if To_Ada(Item => Char_Gen(32)) /= ',' then
231 Report.Failed("Incorrect result from To_Ada with comma " &
232 "char input");
233 end if;
234
235 -- Check that the function Is_Nul_Terminated produces correct results
236 -- whether or not the char_array argument contains the
237 -- Ada.Interfaces.C.nul character.
238
239 TC_String := "abcdefgh";
240 if Is_Nul_Terminated(Item => To_C(TC_String, Append_Nul => False)) then
241 Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
242 "nul char is present");
243 end if;
244
245 if not Is_Nul_Terminated(To_C(TC_String, Append_Nul => True)) then
246 Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
247 "nul char is present");
248 end if;
249
250
251 -- Now that we've tested the character/char versions of To_Ada and To_C,
252 -- use them to test the string versions.
253
254 declare
255 i : size_t := 0;
256 j : integer := 1;
257 Incorrect_Conversion : Boolean := False;
258
259 TC_No_nul : constant char_array := To_C(TC_String, False);
260 TC_nul_Appended : constant char_array := To_C(TC_String, True);
261 begin
262
263 -- Check that the function To_C produces a char_array result with
264 -- lower bound of 0, and length dependent upon the Item and
265 -- Append_Nul parameters (if Append_Nul is True, length is
266 -- Item'Length + 1; if False, length is Item'Length).
267
268 if TC_No_nul'First /= 0 or TC_nul_Appended'First /= 0 then
269 Report.Failed("Incorrect lower bound from Function To_C");
270 end if;
271
272 if TC_No_nul'Length /= TC_String'Length then
273 Report.Failed("Incorrect length returned from Function To_C " &
274 "when Append_Nul => False");
275 end if;
276
277 for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
278 if TC_No_nul(i) /= To_C(TC_char) or -- Single character To_C.
279 TC_nul_Appended(i) /= To_C(TC_char) then
280 Incorrect_Conversion := True;
281 end if;
282 i := i + 1;
283 end loop;
284
285 if Incorrect_Conversion then
286 Report.Failed("Incorrect result from To_C with string input " &
287 "and char_array result");
288 end if;
289
290
291 if TC_nul_Appended'Length /= TC_String'Length + 1 then
292 Report.Failed("Incorrect length returned from Function To_C " &
293 "when Append_Nul => True");
294 end if;
295
296 if not Is_Nul_Terminated(TC_nul_Appended) then
297 Report.Failed("No nul appended to the string parameter during " &
298 "conversion to char_array by function To_C");
299 end if;
300
301
302 -- Check that the function To_Ada produces a string result with
303 -- lower bound of 1, and length dependent upon the Item and
304 -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
305 -- if True, length will be the length of the slice of Item prior to
306 -- the first nul).
307
308 declare
309 TC_No_NUL_String : constant String :=
310 To_Ada(Item => TC_nul_Appended,
311 Trim_Nul => True);
312 TC_NUL_Appended_String : constant String :=
313 To_Ada(TC_nul_Appended, False);
314 begin
315
316 if TC_No_NUL_String'First /= 1 or
317 TC_NUL_Appended_String'First /= 1
318 then
319 Report.Failed("Incorrect lower bound from Function To_Ada");
320 end if;
321
322 if TC_No_NUL_String'Length /= TC_String'Length then
323 Report.Failed("Incorrect length returned from Function " &
324 "To_Ada when Trim_Nul => True");
325 end if;
326
327 if TC_NUL_Appended_String'Length /= TC_String'Length + 1 then
328 Report.Failed("Incorrect length returned from Function " &
329 "To_Ada when Trim_Nul => False");
330 end if;
331
332 Start_Character := Report.Ident_Char('a');
333 Stop_Character := Report.Ident_Char('h');
334 for TC_Character in Start_Character..Stop_Character loop
335 if TC_No_NUL_String(j) /= TC_Character or
336 TC_NUL_Appended_String(j) /= TC_Character
337 then
338 Report.Failed("Incorrect result from To_Ada with " &
339 "char_array input, index = " &
340 Integer'Image(j));
341 end if;
342 j := j + 1;
343 end loop;
344
345 end;
346
347
348 -- Check that the function To_Ada raises Terminator_Error if the
349 -- parameter Trim_Nul is set to True, but the actual Item parameter
350 -- does not contain the nul char.
351
352 begin
353 TC_String := To_Ada(TC_No_nul, Trim_Nul => True);
354 Report.Failed("Terminator_Error not raised when Item " &
355 "parameter of To_Ada does not contain the " &
356 "nul char, but parameter Trim_Nul => True");
357 Report.Comment(TC_String & " printed to defeat optimization");
358 exception
359 when Terminator_Error => null; -- OK, expected exception.
360 when others =>
361 Report.Failed("Incorrect exception raised by function " &
362 "To_Ada when the Item parameter does not " &
363 "contain the nul char, but parameter " &
364 "Trim_Nul => True");
365 end;
366
367 end;
368
369 exception
370 when The_Error : others =>
371 Report.Failed ("The following exception was raised in the " &
372 "Test_Block: " & Exception_Name(The_Error));
373 end Test_Block;
374
375 Report.Result;
376
377 end CXB30041;