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 89with Report; 90with Interfaces.C; -- N/A => ERROR 91with Ada.Characters.Latin_1; 92with Ada.Exceptions; 93with Ada.Strings.Fixed; 94with Impdef; 95 96procedure CXB30041 is 97begin 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 377end CXB30041; 378