|
111
|
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;
|
