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