1-- CXAA017.A 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 Ada.Text_IO function Look_Ahead sets parameter End_Of_Line 28-- to True if at the end of a line; otherwise check that it returns the 29-- next character from a file (without consuming it), while setting 30-- End_Of_Line to False. 31-- 32-- Check that Ada.Text_IO function Get_Immediate will return the next 33-- control or graphic character in parameter Item from the specified 34-- file. Check that the version of Ada.Text_IO function Get_Immediate 35-- with the Available parameter will, if a character is available in the 36-- specified file, return the character in parameter Item, and set 37-- parameter Available to True. 38-- 39-- TEST DESCRIPTION: 40-- This test exercises specific capabilities of two Text_IO subprograms, 41-- Look_Ahead and Get_Immediate. A file is prepared that contains a 42-- variety of graphic and control characters on several lines. 43-- In processing this file, a call to Look_Ahead is performed to ensure 44-- that characters are available, then individual characters are 45-- extracted from the current line using Get_Immediate. The characters 46-- returned from both subprogram calls are compared with the expected 47-- character result. Processing on each file line continues until 48-- Look_Ahead indicates that the end of the line is next. Separate 49-- verification is performed to ensure that all characters of each line 50-- are processed, and that the Available and End_Of_Line parameters 51-- of the subprograms are properly set in the appropriate instances. 52-- 53-- APPLICABILITY CRITERIA: 54-- This test is applicable to implementations capable of supporting 55-- external Text_IO files. 56-- 57-- 58-- CHANGE HISTORY: 59-- 30 May 95 SAIC Initial prerelease version. 60-- 01 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. 61-- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations. 62--! 63 64with Ada.Text_IO; 65package CXAA017_0 is 66 67 User_Defined_Input_File : aliased Ada.Text_IO.File_Type; 68 69end CXAA017_0; 70 71 72with CXAA017_0; use CXAA017_0; 73with Ada.Characters.Latin_1; 74with Ada.Exceptions; 75with Ada.Text_IO; 76with Report; 77 78procedure CXAA017 is 79 80 use Ada.Characters.Latin_1; 81 use Ada.Exceptions; 82 use Ada.Text_IO; 83 84 Non_Applicable_System : exception; 85 No_Reset : exception; 86 87begin 88 89 Report.Test ("CXAA017", "Check that Ada.Text_IO subprograms " & 90 "Look_Ahead and Get_Immediate are available " & 91 "and produce correct results"); 92 93 Test_Block: 94 declare 95 96 User_Input_Ptr : File_Access := User_Defined_Input_File'Access; 97 98 UDLA_Char, -- Acronym UDLA => "User Defined Look Ahead" 99 UDGI_Char, -- Acronym UDGI => "User Defined Get Immediate" 100 TC_Char : Character := Ada.Characters.Latin_1.NUL; 101 102 UDLA_End_Of_Line, 103 UDGI_Available : Boolean := False; 104 105 Char_Pos : Natural; 106 107 -- This string contains five ISO 646 Control characters and six ISO 646 108 -- Graphic characters: 109 TC_String_1 : constant String := STX & 110 SI & 111 DC2 & 112 CAN & 113 US & 114 Space & 115 Ampersand & 116 Solidus & 117 'A' & 118 LC_X & 119 DEL; 120 121 -- This string contains two ISO 6429 Control and six ISO 6429 Graphic 122 -- characters: 123 TC_String_2 : constant String := IS4 & 124 SCI & 125 Yen_Sign & 126 Masculine_Ordinal_Indicator & 127 UC_I_Grave & 128 Multiplication_Sign & 129 LC_C_Cedilla & 130 LC_Icelandic_Thorn; 131 132 TC_Number_Of_Strings : constant := 2; 133 134 type String_Access_Type is access constant String; 135 type String_Ptr_Array_Type is 136 array (1..TC_Number_Of_Strings) of String_Access_Type; 137 138 TC_String_Ptr_Array : String_Ptr_Array_Type := 139 (new String'(TC_String_1), 140 new String'(TC_String_2)); 141 142 143 144 procedure Create_New_File (The_File : in out File_Type; 145 Mode : in File_Mode; 146 Next : in Integer) is 147 begin 148 Create (The_File, Mode, Report.Legal_File_Name(Next)); 149 exception 150 -- The following two exceptions can be raised if a system is not 151 -- capable of supporting external Text_IO files. The handler will 152 -- raise a user-defined exception which will result in a 153 -- Not_Applicable result for the test. 154 when Use_Error | Name_Error => raise Non_Applicable_System; 155 end Create_New_File; 156 157 158 159 procedure Load_File (The_File : in out File_Type) is 160 -- This procedure will load several strings into the file denoted 161 -- by the input parameter. A call to New_Line will add line/page 162 -- termination characters, which will be available for processing 163 -- along with the text in the file. 164 begin 165 Put_Line (The_File, TC_String_Ptr_Array(1).all); 166 New_Line (The_File, Spacing => 1); 167 Put_Line (The_File, TC_String_Ptr_Array(2).all); 168 end Load_File; 169 170 171 begin 172 173 -- Create user-defined text file that will serve as the appropriate 174 -- sources of input to the procedures under test. 175 176 Create_New_File (User_Defined_Input_File, Out_File, 1); 177 178 -- Enter several lines of text into the new input file. 179 -- The characters that make up these text strings will be processed 180 -- using the procedures being exercised in this test. 181 182 Load_File (User_Defined_Input_File); 183 184 -- Check that Mode_Error is raised by Look_Ahead and Get_Immedidate 185 -- if the mode of the file object is not In_File. 186 -- Currently, the file mode is Out_File. 187 188 begin 189 Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line); 190 Report.Failed("Mode_Error not raised by Look_Ahead"); 191 Report.Comment("This char should never be printed: " & UDLA_Char); 192 exception 193 when Mode_Error => null; -- OK, expected exception. 194 when The_Error : others => 195 Report.Failed ("The following exception was raised during the " & 196 "check that Look_Ahead raised Mode_Error when " & 197 "provided a file object that is not in In_File " & 198 "mode: " & Exception_Name(The_Error)); 199 end; 200 201 begin 202 Get_Immediate(User_Defined_Input_File, UDGI_Char); 203 Report.Failed("Mode_Error not raised by Get_Immediate"); 204 Report.Comment("This char should never be printed: " & UDGI_Char); 205 exception 206 when Mode_Error => null; -- OK, expected exception. 207 when The_Error : others => 208 Report.Failed ("The following exception was raised during the " & 209 "check that Get_Immediate raised Mode_Error " & 210 "when provided a file object that is not in " & 211 "In_File mode: " & Exception_Name(The_Error)); 212 end; 213 214 215 -- The file will then be reset to In_File mode to properly function as 216 -- a source of input. 217 218 Reset1: 219 begin 220 Reset (User_Defined_Input_File, In_File); 221 exception 222 when Ada.Text_IO.Use_Error => 223 Report.Not_Applicable 224 ( "Reset to In_File not supported for Text_IO" ); 225 raise No_Reset; 226 end Reset1; 227 228 -- Process the input file, exercising various Text_IO 229 -- functionality, and validating the results at each step. 230 -- Note: The designated File_Access object is used in processing 231 -- the New_Default_Input_File in the second loop below. 232 233 -- Process characters in first line of text of each file. 234 235 Char_Pos := 1; 236 237 -- Check that the first line is not blank. 238 239 Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line); 240 241 while not UDLA_End_Of_Line loop 242 243 -- Use the Get_Immediate procedure on the file to get the next 244 -- available character on the current line. 245 246 Get_Immediate(User_Defined_Input_File, UDGI_Char); 247 248 -- Check that the characters returned by both procedures are the 249 -- same, and that they match the expected character from the file. 250 251 if UDLA_Char /= TC_String_Ptr_Array(1).all(Char_Pos) or 252 UDGI_Char /= TC_String_Ptr_Array(1).all(Char_Pos) 253 then 254 Report.Failed("Incorrect retrieval of character " & 255 Integer'Image(Char_Pos) & " of first string"); 256 end if; 257 258 -- Increment the character position counter. 259 Char_Pos := Char_Pos + 1; 260 261 -- Check the next character on the line. If at the end of line, 262 -- the processing flow will exit the While loop. 263 264 Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line); 265 266 end loop; 267 268 -- Check to ensure that the "end of line" results returned from the 269 -- Look_Ahead procedure (used to exit the above While loop) corresponds 270 -- with the result of Function End_Of_Line. 271 272 if not End_Of_Line(User_Defined_Input_File) 273 then 274 Report.Failed("Result of procedure Look_Ahead that indicated " & 275 "being at the end of the line does not correspond " & 276 "with the result of function End_Of_Line"); 277 end if; 278 279 -- Check that all characters in the string were processed. 280 281 if Char_Pos-1 /= TC_String_1'Length then 282 Report.Failed("Not all of the characters on the first line " & 283 "were processed"); 284 end if; 285 286 287 -- Call procedure Skip_Line to advance beyond the end of the first line. 288 289 Skip_Line(User_Defined_Input_File); 290 291 292 -- Process the second line in the file (a blank line). 293 294 Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line); 295 296 if not UDLA_End_Of_Line then 297 Report.Failed("Incorrect end of line determination from procedure " & 298 "Look_Ahead when processing a blank line"); 299 end if; 300 301 -- Call procedure Skip_Line to advance beyond the end of the second line. 302 303 Skip_Line(User_Input_Ptr.all); 304 305 306 -- Process characters in the third line of the file (second line 307 -- of text) 308 -- Note: The version of Get_Immediate used in processing this line has 309 -- the Boolean parameter Available. 310 311 Char_Pos := 1; 312 313 -- Check whether the line is blank (i.e., at end of line, page, or file). 314 315 Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line); 316 317 while not UDLA_End_Of_Line loop 318 319 -- Use the Get_Immediate procedure on the file to get access to the 320 -- next character on the current line. 321 322 Get_Immediate(User_Input_Ptr.all, UDGI_Char, UDGI_Available); 323 324 -- Check that the Available parameter of Get_Immediate was set 325 -- to indicate that a character was available in the file. 326 -- Check that the characters returned by both procedures are the 327 -- same, and they all match the expected character from the file. 328 329 if not UDGI_Available or 330 UDLA_Char /= TC_String_Ptr_Array(2).all(Char_Pos) or 331 UDGI_Char /= TC_String_Ptr_Array(2).all(Char_Pos) 332 then 333 Report.Failed("Incorrect retrieval of character " & 334 Integer'Image(Char_Pos) & " of second string"); 335 end if; 336 337 -- Increment the character position counter. 338 339 Char_Pos := Char_Pos + 1; 340 341 -- Check the next character on the line. If at the end of line, 342 -- the processing flow will exit the While loop. 343 344 Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line); 345 346 end loop; 347 348 -- Check to ensure that the "end of line" results returned from the 349 -- Look_Ahead procedure (used to exit the above While loop) corresponds 350 -- with the result of Function End_Of_Line. 351 352 if not End_Of_Line(User_Defined_Input_File) 353 then 354 Report.Failed("Result of procedure Look_Ahead that indicated " & 355 "being at the end of the line does not correspond " & 356 "with the result of function End_Of_Line"); 357 end if; 358 359 -- Check that all characters in the second string were processed. 360 361 if Char_Pos-1 /= TC_String_2'Length then 362 Report.Failed("Not all of the characters on the second line " & 363 "were processed"); 364 end if; 365 366 367 Deletion: 368 begin 369 -- Delete the user defined file. 370 371 if Is_Open(User_Defined_Input_File) then 372 Delete(User_Defined_Input_File); 373 else 374 Open(User_Defined_Input_File, Out_File, Report.Legal_File_Name(1)); 375 Delete(User_Defined_Input_File); 376 end if; 377 exception 378 when others => 379 Report.Failed 380 ( "Delete not properly implemented for Text_IO" ); 381 end Deletion; 382 383 384 exception 385 386 when No_Reset => 387 null; 388 389 when Non_Applicable_System => 390 Report.Not_Applicable("System not capable of supporting external " & 391 "text files -- Name_Error/Use_Error raised " & 392 "during text file creation"); 393 when The_Error : others => 394 Report.Failed ("The following exception was raised in the " & 395 "Test_Block: " & Exception_Name(The_Error)); 396 end Test_Block; 397 398 Report.Result; 399 400end CXAA017; 401