1-- CXACA01.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 the default attributes 'Write and 'Read work properly when 28-- used with objects of a variety of types, including records with 29-- default discriminants, records without default discriminants, but 30-- which have the discriminant described in a representation clause for 31-- the type, and arrays. 32-- 33-- TEST DESCRIPTION: 34-- This test simulates a basic sales record system, using Stream_IO to 35-- allow the storage of heterogeneous data in a single stream file. 36-- 37-- Four types of data are written to the stream file for each product. 38-- First, the "header" information on the product is written. 39-- This is an object of a discriminated (with default) record 40-- type. This is followed by an integer object containing a count of 41-- the number of sales data records to follow. The corresponding number 42-- of sales records follow in the stream. These are of a record type 43-- with a discriminant without a default, but where the discriminant is 44-- included in the representation clause for the type. Finally, an 45-- array object with statistical sales information for the product is 46-- written to the stream. 47-- 48-- Objects of both record types specified below (discriminated records 49-- with defaults, and discriminated records w/o defaults that have the 50-- discriminant included in a representation clause for the type) should 51-- have their discriminants included in the stream when using 'Write. 52-- Likewise, discriminants should be extracted from the stream when 53-- using 'Read. 54-- 55-- APPLICABILITY CRITERIA: 56-- Applicable to all implementations that support external 57-- Stream_IO files. 58-- 59-- 60-- CHANGE HISTORY: 61-- 06 Dec 94 SAIC ACVC 2.0 62-- 63--! 64 65with FXACA00; 66with Ada.Streams.Stream_IO; 67with Report; 68 69procedure CXACA01 is 70 71begin 72 73 Report.Test ("CXACA01", "Check that 'Write and 'Read work properly " & 74 "when used with complex data types"); 75 76 Test_for_Stream_IO_Support: 77 declare 78 79 Info_File : Ada.Streams.Stream_IO.File_Type; 80 Info_Stream : Ada.Streams.Stream_IO.Stream_Access; 81 The_Filename : constant String := Report.Legal_File_Name; 82 83 begin 84 85 -- If an implementation does not support Stream_IO in a particular 86 -- environment, the exception Use_Error or Name_Error will be raised on 87 -- calls to various Stream_IO operations. This block statement 88 -- encloses a call to Create, which should produce an exception in a 89 -- non-supportive environment. These exceptions will be handled to 90 -- produce a Not_Applicable result. 91 92 Ada.Streams.Stream_IO.Create (Info_File, 93 Ada.Streams.Stream_IO.Out_File, 94 The_Filename); 95 96 Operational_Test_Block: 97 declare 98 99 begin 100 101 Info_Stream := Ada.Streams.Stream_IO.Stream (Info_File); 102 103 -- Write all of the product information (record, integer, and array 104 -- objects) defined in package FXACA00 into the stream. 105 106 Store_Data_Block: 107 begin 108 109 -- Write information about first product to the stream. 110 FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_01); 111 Integer'Write (Info_Stream, FXACA00.Sale_Count_01); 112 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_01); 113 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_02); 114 FXACA00.Sales_Statistics_Type'Write 115 (Info_Stream, FXACA00.Product_01_Stats); 116 117 -- Write information about second product to the stream. 118 -- Note: No Sales_Record_Type objects. 119 FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_02); 120 Integer'Write (Info_Stream, FXACA00.Sale_Count_02); 121 FXACA00.Sales_Statistics_Type'Write 122 (Info_Stream, FXACA00.Product_02_Stats); 123 124 -- Write information about third product to the stream. 125 FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_03); 126 Integer'Write (Info_Stream, FXACA00.Sale_Count_03); 127 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_03); 128 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_04); 129 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_05); 130 FXACA00.Sales_Statistics_Type'Write 131 (Info_Stream, FXACA00.Product_03_Stats); 132 133 end Store_Data_Block; 134 135 136 Verify_Data_Block: 137 declare 138 139 use FXACA00; -- Used within this block only. 140 141 type Domestic_Rec_Array_Type is 142 array (Positive range <>) of Sales_Record_Type (Domestic); 143 144 type Foreign_Rec_Array_Type is 145 array (Positive range <>) of Sales_Record_Type (Foreign); 146 147 TC_Rec1 : Domestic_Rec_Array_Type (1..2); 148 TC_Rec3 : Foreign_Rec_Array_Type (1..3); 149 150 TC_Product1 : Product_Type; 151 TC_Product2, 152 TC_Product3 : Product_Type (Foreign); 153 154 TC_Count1, 155 TC_Count2, 156 TC_Count3 : Integer := -10; -- Initialized to dummy value. 157 158 TC_Stat1, 159 TC_Stat2, 160 TC_Stat3 : Sales_Statistics_Type := (others => 500); 161 162 begin 163 164 Ada.Streams.Stream_IO.Reset (Info_File, 165 Ada.Streams.Stream_IO.In_File); 166 167 -- Read all of the data that is contained in the stream. 168 -- Compare all data with the original data in package FXACA00 169 -- that was written to the stream. 170 -- The calls to the read attribute are in anticipated order, based 171 -- on the order of data written to the stream. Possible errors, 172 -- such as data placement, overwriting, etc., will be manifest as 173 -- exceptions raised by the attribute during an unsuccessful read 174 -- attempt. 175 176 -- Extract data on first product. 177 Product_Type'Read (Info_Stream, TC_Product1); 178 Integer'Read (Info_Stream, TC_Count1); 179 180 -- Two "domestic" variant sales records will be read from the 181 -- stream. 182 for i in 1 .. TC_Count1 loop 183 Sales_Record_Type'Read (Info_Stream, TC_Rec1(i) ); 184 end loop; 185 186 Sales_Statistics_Type'Read (Info_Stream, TC_Stat1); 187 188 189 -- Extract data on second product. 190 Product_Type'Read (Info_Stream, TC_Product2); 191 Integer'Read (Info_Stream, TC_Count2); 192 Sales_Statistics_Type'Read (Info_Stream, TC_Stat2); 193 194 195 -- Extract data on third product. 196 Product_Type'Read (Info_Stream, TC_Product3); 197 Integer'Read (Info_Stream, TC_Count3); 198 199 -- Three "foreign" variant sales records will be read from the 200 -- stream. 201 for i in 1 .. TC_Count3 loop 202 Sales_Record_Type'Read (Info_Stream, TC_Rec3(i) ); 203 end loop; 204 205 Sales_Statistics_Type'Read (Info_Stream, TC_Stat3); 206 207 208 -- After all the data has been correctly extracted, the file 209 -- should be empty. 210 211 if not Ada.Streams.Stream_IO.End_Of_File (Info_File) then 212 Report.Failed ("Stream file not empty"); 213 end if; 214 215 -- Verify that the data values read from the stream are the same 216 -- as those written to the stream. 217 218 -- Verify the information of the first product. 219 if ((Product_01 /= TC_Product1) or else 220 (Product_01.Manufacture /= TC_Product1.Manufacture) or else 221 (Sale_Count_01 /= TC_Count1) or else 222 (Sale_Rec_01 /= TC_Rec1(1)) or else 223 (Sale_Rec_01.Buyer /= TC_Rec1(1).Buyer) or else 224 (Sale_Rec_02 /= TC_Rec1(2)) or else 225 (Sale_Rec_02.Buyer /= TC_Rec1(2).Buyer) or else 226 (Product_01_Stats /= TC_Stat1)) 227 then 228 Report.Failed ("Product 1 information incorrect"); 229 end if; 230 231 -- Verify the information of the second product. 232 if not ((Product_02 = TC_Product2) and then 233 (Sale_Count_02 = TC_Count2) and then 234 (Product_02_Stats = TC_Stat2)) 235 then 236 Report.Failed ("Product 2 information incorrect"); 237 end if; 238 239 -- Verify the information of the third product. 240 if ((Product_03 /= TC_Product3) or else 241 (Product_03.Manufacture /= TC_Product3.Manufacture) or else 242 (Sale_Count_03 /= TC_Count3) or else 243 (Sale_Rec_03 /= TC_Rec3(1)) or else 244 (Sale_Rec_03.Buyer /= TC_Rec3(1).Buyer) or else 245 (Sale_Rec_04 /= TC_Rec3(2)) or else 246 (Sale_Rec_04.Buyer /= TC_Rec3(2).Buyer) or else 247 (Sale_Rec_05 /= TC_Rec3(3)) or else 248 (Sale_Rec_05.Buyer /= TC_Rec3(3).Buyer) or else 249 (Product_03_Stats /= TC_Stat3)) 250 then 251 Report.Failed ("Product 3 information incorrect"); 252 end if; 253 254 end Verify_Data_Block; 255 256 exception 257 258 when others => 259 Report.Failed ("Exception raised in Operational Test Block"); 260 261 end Operational_Test_Block; 262 263 if Ada.Streams.Stream_IO.Is_Open (Info_File) then 264 Ada.Streams.Stream_IO.Delete (Info_File); 265 else 266 Ada.Streams.Stream_IO.Open (Info_File, 267 Ada.Streams.Stream_IO.In_File, 268 The_Filename); 269 Ada.Streams.Stream_IO.Delete (Info_File); 270 end if; 271 272 exception 273 274 -- Since Use_Error or Name_Error can be raised if, for the specified 275 -- mode, the environment does not support Stream_IO operations, 276 -- the following handlers are included: 277 278 when Ada.Streams.Stream_IO.Name_Error => 279 Report.Not_Applicable ("Name_Error raised on Stream IO Create"); 280 281 when Ada.Streams.Stream_IO.Use_Error => 282 Report.Not_Applicable ("Use_Error raised on Stream IO Create"); 283 284 when others => 285 Report.Failed ("Unexpected exception raised on Stream IO Create"); 286 287 end Test_for_Stream_IO_Support; 288 289 Report.Result; 290 291end CXACA01; 292