-- CXA9001.A
|
-- CXA9001.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that the operations defined in the generic package
|
-- Check that the operations defined in the generic package
|
-- Ada.Storage_IO provide the ability to store and retrieve objects
|
-- Ada.Storage_IO provide the ability to store and retrieve objects
|
-- which may include implicit levels of indirection in their
|
-- which may include implicit levels of indirection in their
|
-- implementation, from an in-memory buffer.
|
-- implementation, from an in-memory buffer.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- The following scenario demonstrates how an object of a type with
|
-- The following scenario demonstrates how an object of a type with
|
-- (potential) levels of indirection (based on the implementation)
|
-- (potential) levels of indirection (based on the implementation)
|
-- can be "flattened" and written/read to/from a Direct_IO file.
|
-- can be "flattened" and written/read to/from a Direct_IO file.
|
-- In this small example, we have attempted to simulate the situation
|
-- In this small example, we have attempted to simulate the situation
|
-- where two independent programs are using a particular Direct_IO file,
|
-- where two independent programs are using a particular Direct_IO file,
|
-- one writing data to the file, and the second program reading that file.
|
-- one writing data to the file, and the second program reading that file.
|
-- The Storage_IO Read and Write procedures are used to "flatten"
|
-- The Storage_IO Read and Write procedures are used to "flatten"
|
-- and reconstruct objects of the record type.
|
-- and reconstruct objects of the record type.
|
--
|
--
|
-- APPLICABILITY CRITERIA:
|
-- APPLICABILITY CRITERIA:
|
-- Applicable to implementations capable of supporting external
|
-- Applicable to implementations capable of supporting external
|
-- Direct_IO files.
|
-- Direct_IO files.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 07 Jun 95 SAIC Modified to constrain type used with Storage_IO.
|
-- 07 Jun 95 SAIC Modified to constrain type used with Storage_IO.
|
-- 20 Nov 95 SAIC Corrected and enhanced for ACVC 2.0.1.
|
-- 20 Nov 95 SAIC Corrected and enhanced for ACVC 2.0.1.
|
-- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
|
-- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
with Ada.Storage_IO;
|
with Ada.Storage_IO;
|
with Ada.Direct_IO;
|
with Ada.Direct_IO;
|
|
|
procedure CXA9001 is
|
procedure CXA9001 is
|
package Dir_IO is new Ada.Direct_IO (Integer);
|
package Dir_IO is new Ada.Direct_IO (Integer);
|
Test_File : Dir_IO.File_Type;
|
Test_File : Dir_IO.File_Type;
|
Incomplete : exception;
|
Incomplete : exception;
|
begin
|
begin
|
|
|
Report.Test ("CXA9001", "Check that the operations defined in the " &
|
Report.Test ("CXA9001", "Check that the operations defined in the " &
|
"generic package Ada.Storage_IO provide the " &
|
"generic package Ada.Storage_IO provide the " &
|
"ability to store and retrieve objects which " &
|
"ability to store and retrieve objects which " &
|
"may include implicit levels of indirection in " &
|
"may include implicit levels of indirection in " &
|
"their implementation, from an in-memory buffer");
|
"their implementation, from an in-memory buffer");
|
|
|
|
|
Test_For_Direct_IO_Support:
|
Test_For_Direct_IO_Support:
|
begin
|
begin
|
|
|
-- The following Create does not have any bearing on the test scenario,
|
-- The following Create does not have any bearing on the test scenario,
|
-- but is included to check that the implementation supports Direct_IO
|
-- but is included to check that the implementation supports Direct_IO
|
-- files. An exception on this Create statement will raise a Name_Error
|
-- files. An exception on this Create statement will raise a Name_Error
|
-- or Use_Error, which will be handled to produce a Not_Applicable
|
-- or Use_Error, which will be handled to produce a Not_Applicable
|
-- result. If created, the file is immediately deleted, as it is not
|
-- result. If created, the file is immediately deleted, as it is not
|
-- needed for the program scenario.
|
-- needed for the program scenario.
|
|
|
Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
|
Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
|
|
|
exception
|
exception
|
|
|
when Dir_IO.Use_Error | Dir_IO.Name_Error =>
|
when Dir_IO.Use_Error | Dir_IO.Name_Error =>
|
Report.Not_Applicable
|
Report.Not_Applicable
|
( "Files not supported - Create as Out_File for Direct_IO" );
|
( "Files not supported - Create as Out_File for Direct_IO" );
|
raise Incomplete;
|
raise Incomplete;
|
|
|
end Test_for_Direct_IO_Support;
|
end Test_for_Direct_IO_Support;
|
|
|
Deletion1:
|
Deletion1:
|
begin
|
begin
|
Dir_IO.Delete (Test_File);
|
Dir_IO.Delete (Test_File);
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed
|
Report.Failed
|
( "Delete not properly implemented for Direct_IO - 1" );
|
( "Delete not properly implemented for Direct_IO - 1" );
|
end Deletion1;
|
end Deletion1;
|
|
|
|
|
Test_Block:
|
Test_Block:
|
declare
|
declare
|
|
|
The_Filename : constant String := Report.Legal_File_Name(2);
|
The_Filename : constant String := Report.Legal_File_Name(2);
|
|
|
-- The following type is the basic unit used in this test. It is
|
-- The following type is the basic unit used in this test. It is
|
-- incorporated into the definition of the Unit_Array_Type.
|
-- incorporated into the definition of the Unit_Array_Type.
|
|
|
type Unit_Type is
|
type Unit_Type is
|
record
|
record
|
Position : Natural := 19;
|
Position : Natural := 19;
|
String_Value : String (1..9) := (others => 'X');
|
String_Value : String (1..9) := (others => 'X');
|
end record;
|
end record;
|
|
|
TC_Size : Natural := Natural'First;
|
TC_Size : Natural := Natural'First;
|
|
|
procedure Data_Storage (Number_Of_Units : in Natural;
|
procedure Data_Storage (Number_Of_Units : in Natural;
|
Result : out Natural) is
|
Result : out Natural) is
|
|
|
-- Type based on input parameter. Uses type Unit_Type
|
-- Type based on input parameter. Uses type Unit_Type
|
-- as the array element.
|
-- as the array element.
|
type Unit_Array_Type is array (1..Number_Of_Units)
|
type Unit_Array_Type is array (1..Number_Of_Units)
|
of Unit_Type;
|
of Unit_Type;
|
|
|
-- This type definition is the ultimate storage type used
|
-- This type definition is the ultimate storage type used
|
-- in this test; uses type Unit_Array_Type as a record
|
-- in this test; uses type Unit_Array_Type as a record
|
-- component field.
|
-- component field.
|
-- This record type contains a component that is an array of
|
-- This record type contains a component that is an array of
|
-- records, with each of these records containing a Natural
|
-- records, with each of these records containing a Natural
|
-- and a String value (i.e., a record containing an array of
|
-- and a String value (i.e., a record containing an array of
|
-- records).
|
-- records).
|
|
|
type Data_Storage_Type is
|
type Data_Storage_Type is
|
record
|
record
|
Data_Value : Natural := Number_Of_Units;
|
Data_Value : Natural := Number_Of_Units;
|
Unit_Array : Unit_Array_Type;
|
Unit_Array : Unit_Array_Type;
|
end record;
|
end record;
|
|
|
-- The instantiation of the following generic package is a
|
-- The instantiation of the following generic package is a
|
-- central point in this test. Storage_IO is instantiated for
|
-- central point in this test. Storage_IO is instantiated for
|
-- a specific data type, and will be used to "flatten" objects
|
-- a specific data type, and will be used to "flatten" objects
|
-- of that type into buffers. Direct_IO is instantiated for
|
-- of that type into buffers. Direct_IO is instantiated for
|
-- these Storage_IO buffers.
|
-- these Storage_IO buffers.
|
|
|
package Flat_Storage_IO is
|
package Flat_Storage_IO is
|
new Ada.Storage_IO (Data_Storage_Type);
|
new Ada.Storage_IO (Data_Storage_Type);
|
package Buffer_IO is
|
package Buffer_IO is
|
new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
|
new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
|
|
|
Buffer_File : Buffer_IO.File_Type;
|
Buffer_File : Buffer_IO.File_Type;
|
Outbound_Buffer : Flat_Storage_IO.Buffer_Type;
|
Outbound_Buffer : Flat_Storage_IO.Buffer_Type;
|
Storage_Item : Data_Storage_Type;
|
Storage_Item : Data_Storage_Type;
|
|
|
begin -- procedure Data_Storage
|
begin -- procedure Data_Storage
|
|
|
Buffer_IO.Create (Buffer_File,
|
Buffer_IO.Create (Buffer_File,
|
Buffer_IO.Out_File,
|
Buffer_IO.Out_File,
|
The_Filename);
|
The_Filename);
|
|
|
Flat_Storage_IO.Write (Buffer => Outbound_Buffer,
|
Flat_Storage_IO.Write (Buffer => Outbound_Buffer,
|
Item => Storage_Item);
|
Item => Storage_Item);
|
|
|
-- At this point, any levels of indirection have been removed
|
-- At this point, any levels of indirection have been removed
|
-- by the Storage_IO procedure, and the buffered data can be
|
-- by the Storage_IO procedure, and the buffered data can be
|
-- written to a file.
|
-- written to a file.
|
|
|
Buffer_IO.Write (Buffer_File, Outbound_Buffer);
|
Buffer_IO.Write (Buffer_File, Outbound_Buffer);
|
Buffer_IO.Close (Buffer_File);
|
Buffer_IO.Close (Buffer_File);
|
Result := Storage_Item.Unit_Array'Last + -- 5 +
|
Result := Storage_Item.Unit_Array'Last + -- 5 +
|
Storage_Item.Unit_Array -- 9
|
Storage_Item.Unit_Array -- 9
|
(Storage_Item.Unit_Array'First).String_Value'Length;
|
(Storage_Item.Unit_Array'First).String_Value'Length;
|
|
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed ("Data storage error");
|
Report.Failed ("Data storage error");
|
if Buffer_IO.Is_Open (Buffer_File) then
|
if Buffer_IO.Is_Open (Buffer_File) then
|
Buffer_IO.Close (Buffer_File);
|
Buffer_IO.Close (Buffer_File);
|
end if;
|
end if;
|
end Data_Storage;
|
end Data_Storage;
|
|
|
procedure Data_Retrieval (Number_Of_Units : in Natural;
|
procedure Data_Retrieval (Number_Of_Units : in Natural;
|
Result : out Natural) is
|
Result : out Natural) is
|
type Unit_Array_Type is array (1..Number_Of_Units)
|
type Unit_Array_Type is array (1..Number_Of_Units)
|
of Unit_Type;
|
of Unit_Type;
|
|
|
type Data_Storage_Type is
|
type Data_Storage_Type is
|
record
|
record
|
Data_Value : Natural := Number_Of_Units;
|
Data_Value : Natural := Number_Of_Units;
|
Unit_Array : Unit_Array_Type;
|
Unit_Array : Unit_Array_Type;
|
end record;
|
end record;
|
|
|
package Flat_Storage_IO is
|
package Flat_Storage_IO is
|
new Ada.Storage_IO (Data_Storage_Type);
|
new Ada.Storage_IO (Data_Storage_Type);
|
package Reader_IO is
|
package Reader_IO is
|
new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
|
new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
|
|
|
Reader_File : Reader_IO.File_Type;
|
Reader_File : Reader_IO.File_Type;
|
Inbound_Buffer : Flat_Storage_IO.Buffer_Type;
|
Inbound_Buffer : Flat_Storage_IO.Buffer_Type;
|
Storage_Item : Data_Storage_Type;
|
Storage_Item : Data_Storage_Type;
|
TC_Item : Data_Storage_Type;
|
TC_Item : Data_Storage_Type;
|
|
|
begin -- procedure Data_Retrieval
|
begin -- procedure Data_Retrieval
|
|
|
Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
|
Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
|
Reader_IO.Read (Reader_File, Inbound_Buffer);
|
Reader_IO.Read (Reader_File, Inbound_Buffer);
|
|
|
Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
|
Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
|
|
|
-- Validate the reconstructed value against an "unflattened"
|
-- Validate the reconstructed value against an "unflattened"
|
-- value.
|
-- value.
|
|
|
if Storage_Item.Data_Value /= TC_Item.Data_Value
|
if Storage_Item.Data_Value /= TC_Item.Data_Value
|
then
|
then
|
Report.Failed ("Data_Retrieval Error - 1");
|
Report.Failed ("Data_Retrieval Error - 1");
|
end if;
|
end if;
|
|
|
for i in 1..Number_Of_Units loop
|
for i in 1..Number_Of_Units loop
|
if Storage_Item.Unit_Array(i).String_Value'Length /=
|
if Storage_Item.Unit_Array(i).String_Value'Length /=
|
TC_Item.Unit_Array(i).String_Value'Length or
|
TC_Item.Unit_Array(i).String_Value'Length or
|
Storage_Item.Unit_Array(i).Position /=
|
Storage_Item.Unit_Array(i).Position /=
|
TC_Item.Unit_Array(i).Position or
|
TC_Item.Unit_Array(i).Position or
|
Storage_Item.Unit_Array(i).String_Value /=
|
Storage_Item.Unit_Array(i).String_Value /=
|
TC_Item.Unit_Array(i).String_Value
|
TC_Item.Unit_Array(i).String_Value
|
then
|
then
|
Report.Failed ("Data_Retrieval Error - 2");
|
Report.Failed ("Data_Retrieval Error - 2");
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
Result := Storage_Item.Unit_Array'Last + -- 5 +
|
Result := Storage_Item.Unit_Array'Last + -- 5 +
|
Storage_Item.Unit_Array -- 9
|
Storage_Item.Unit_Array -- 9
|
(Storage_Item.Unit_Array'First).String_Value'Length;
|
(Storage_Item.Unit_Array'First).String_Value'Length;
|
|
|
if Reader_IO.Is_Open (Reader_File) then
|
if Reader_IO.Is_Open (Reader_File) then
|
Reader_IO.Delete (Reader_File);
|
Reader_IO.Delete (Reader_File);
|
else
|
else
|
Reader_IO.Open (Reader_File,
|
Reader_IO.Open (Reader_File,
|
Reader_IO.In_File,
|
Reader_IO.In_File,
|
The_Filename);
|
The_Filename);
|
Reader_IO.Delete (Reader_File);
|
Reader_IO.Delete (Reader_File);
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when others =>
|
when others =>
|
Report.Failed ("Exception raised in Data_Retrieval");
|
Report.Failed ("Exception raised in Data_Retrieval");
|
if Reader_IO.Is_Open (Reader_File) then
|
if Reader_IO.Is_Open (Reader_File) then
|
Reader_IO.Delete (Reader_File);
|
Reader_IO.Delete (Reader_File);
|
else
|
else
|
Reader_IO.Open (Reader_File,
|
Reader_IO.Open (Reader_File,
|
Reader_IO.In_File,
|
Reader_IO.In_File,
|
The_Filename);
|
The_Filename);
|
Reader_IO.Delete (Reader_File);
|
Reader_IO.Delete (Reader_File);
|
end if;
|
end if;
|
end Data_Retrieval;
|
end Data_Retrieval;
|
|
|
|
|
begin -- Test_Block
|
begin -- Test_Block
|
|
|
-- The number of Units is provided in this call to Data_Storage.
|
-- The number of Units is provided in this call to Data_Storage.
|
Data_Storage (Number_Of_Units => Natural(Report.Ident_Int(5)),
|
Data_Storage (Number_Of_Units => Natural(Report.Ident_Int(5)),
|
Result => TC_Size);
|
Result => TC_Size);
|
|
|
if TC_Size /= 14 then
|
if TC_Size /= 14 then
|
Report.Failed ("Data_Storage error in Data_Storage");
|
Report.Failed ("Data_Storage error in Data_Storage");
|
end if;
|
end if;
|
|
|
Data_Retrieval (Number_Of_Units => Natural(Report.Ident_Int(5)),
|
Data_Retrieval (Number_Of_Units => Natural(Report.Ident_Int(5)),
|
Result => TC_Size);
|
Result => TC_Size);
|
|
|
if TC_Size /= 14 then
|
if TC_Size /= 14 then
|
Report.Failed ("Data retrieval error in Data_Retrieval");
|
Report.Failed ("Data retrieval error in Data_Retrieval");
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when others => Report.Failed ("Exception raised in Test_Block");
|
when others => Report.Failed ("Exception raised in Test_Block");
|
end Test_Block;
|
end Test_Block;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
exception
|
exception
|
when Incomplete =>
|
when Incomplete =>
|
Report.Result;
|
Report.Result;
|
when others =>
|
when others =>
|
Report.Failed ( "Unexpected exception" );
|
Report.Failed ( "Unexpected exception" );
|
Report.Result;
|
Report.Result;
|
|
|
end CXA9001;
|
end CXA9001;
|
|
|
