|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T V ┃
Length: 24838 (0x6106)
Types: TextFile
Names: »V«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦49e7f20b9⟧
└─⟦this⟧
with Swap_Raw_Data;
with Swap_U_Char;
with Xlbmt_Network_Types;
with Xlbt_Arithmetic;
with Xlbt_String;
pragma Elaborate (Swap_Raw_Data);
pragma Elaborate (Swap_U_Char);
package Cvt_Test_Utilities is
------------------------------------------------------------------------------
-- Cvt_Test_Utilities - test generics and support routines useful for
-- testing data conversions.
------------------------------------------------------------------------------
package Raw_Data_Tests is
--------------------------------------------------------------------
-- The test generics in this section will perform a series of
-- standard tests with a given pair of converter subprograms. The
-- test generics below require both To_Raw and From_Raw converters.
-- If a particular conversion is not used by the protocol, the
-- standard converter packages will not supply a converter
-- subprogram. Instantiate an appropriate Dummy_Converter
-- to handle these cases. The test generics below all accept and
-- handle the Dummy_Converters.Unimplemented exception.
--
-- Logging information is produced via Test_Io calls.
--------------------------------------------------------------------
generic
type Original is private;
Original_Name : String;
with procedure To_Raw
(Raw : out Xlbmt_Network_Types.X_Raw_Data_Array;
Orig : Original);
with procedure From_Raw
(Orig : out Original;
Raw : Xlbmt_Network_Types.X_Raw_Data_Array);
procedure Tester (Image : String;
Orig : Original;
Raw : Xlbmt_Network_Types.X_Raw_Data_Array);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Raw - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of private values.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
generic
type Original is private;
type Index is (<>);
type Original_Array is array (Index range <>) of Original;
Original_Name : String;
with procedure To_Raw (Raw : out
Xlbmt_Network_Types.X_Raw_Data_Array;
Orig : Original_Array);
with procedure From_Raw
(Orig : out Original_Array;
Raw : Xlbmt_Network_Types.X_Raw_Data_Array);
procedure Tester_1d (Image : String;
Orig : Original_Array;
Raw : Xlbmt_Network_Types.X_Raw_Data_Array);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Raw - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of array values.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
generic
type Original is private;
type Index1 is (<>);
type Index2 is (<>);
type Original_Array is array (Index1 range <>,
Index2 range <>) of Original;
Original_Name : String;
with procedure To_Raw (Raw : out
Xlbmt_Network_Types.X_Raw_Data_Array;
Orig : Original_Array);
with procedure From_Raw
(Orig : out Original_Array;
Raw : Xlbmt_Network_Types.X_Raw_Data_Array);
procedure Tester_2d (Image : String;
Orig : Original_Array;
Raw : Xlbmt_Network_Types.X_Raw_Data_Array);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Raw - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of 2d array values.
end Raw_Data_Tests;
----------------------------------------------------------------------
package U_Char_Tests is
--------------------------------------------------------------------
-- The test generics in this section will perform a series of
-- standard tests with a given pair of converter subprograms. The
-- test generics below require both To_Uca and From_Uca converters.
-- If a particular conversion is not used by the protocol, the
-- standard converter packages will not supply a converter
-- subprogram. Instantiate an appropriate Dummy_Converter
-- to handle these cases. The test generics below all accept and
-- handle the Dummy_Converters.Unimplemented exception.
--
-- Logging information is produced via Test_Io calls.
--------------------------------------------------------------------
generic
type Original is private;
Original_Name : String;
with procedure To_Uca (Uca : out Xlbt_Arithmetic.U_Char_Array;
Orig : Original);
with procedure From_Uca (Orig : out Original;
Uca : Xlbt_Arithmetic.U_Char_Array);
procedure Tester (Image : String;
Orig : Original;
Uca : Xlbt_Arithmetic.U_Char_Array);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Uca - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of private values.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
generic
type Original is private;
type Index is (<>);
type Original_Array is array (Index range <>) of Original;
Original_Name : String;
with procedure To_Uca (Uca : out Xlbt_Arithmetic.U_Char_Array;
Orig : Original_Array);
with procedure From_Uca (Orig : out Original_Array;
Uca : Xlbt_Arithmetic.U_Char_Array);
procedure Tester_1d (Image : String;
Orig : Original_Array;
Uca : Xlbt_Arithmetic.U_Char_Array);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Uca - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of array values.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
generic
type Original is private;
type Index1 is (<>);
type Index2 is (<>);
type Original_Array is array (Index1 range <>,
Index2 range <>) of Original;
Original_Name : String;
with procedure To_Uca (Uca : out Xlbt_Arithmetic.U_Char_Array;
Orig : Original_Array);
with procedure From_Uca (Orig : out Original_Array;
Uca : Xlbt_Arithmetic.U_Char_Array);
procedure Tester_2d (Image : String;
Orig : Original_Array;
Uca : Xlbt_Arithmetic.U_Char_Array);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Uca - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of 2d array values.
end U_Char_Tests;
----------------------------------------------------------------------
package X_String_Tests is
--------------------------------------------------------------------
-- The test generics in this section will perform a series of
-- standard tests with a given pair of converter subprograms. The
-- test generics below require both To_Str8 and From_Str8 converters.
-- If a particular conversion is not used by the protocol, the
-- standard converter packages will not supply a converter
-- subprogram. Instantiate an appropriate Dummy_Converter
-- to handle these cases. The test generics below all accept and
-- handle the Dummy_Converters.Unimplemented exception.
--
-- Logging information is produced via Test_Io calls.
--------------------------------------------------------------------
generic
type Original is private;
Original_Name : String;
with procedure To_Str8 (Str8 : out Xlbt_String.X_String;
Orig : Original);
with procedure From_Str8 (Orig : out Original;
Str8 : Xlbt_String.X_String);
procedure Tester (Image : String;
Orig : Original;
Str8 : Xlbt_String.X_String);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Str8 - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of private values.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
generic
type Original is private;
type Index is (<>);
type Original_Array is array (Index range <>) of Original;
Original_Name : String;
with procedure To_Str8 (Str8 : out Xlbt_String.X_String;
Orig : Original_Array);
with procedure From_Str8 (Orig : out Original_Array;
Str8 : Xlbt_String.X_String);
procedure Tester_1d (Image : String;
Orig : Original_Array;
Str8 : Xlbt_String.X_String);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Str8 - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of array values.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
generic
type Original is private;
type Index1 is (<>);
type Index2 is (<>);
type Original_Array is array (Index1 range <>,
Index2 range <>) of Original;
Original_Name : String;
with procedure To_Str8 (Str8 : out Xlbt_String.X_String;
Orig : Original_Array);
with procedure From_Str8 (Orig : out Original_Array;
Str8 : Xlbt_String.X_String);
procedure Tester_2d (Image : String;
Orig : Original_Array;
Str8 : Xlbt_String.X_String);
--
-- Image - Specifies a text representation for Orig.
-- Orig - Specifies the original value to be converted.
-- Str8 - Specifies the equivalent converted value.
--
-- Called to exercise various conversions of 2d array values.
end X_String_Tests;
----------------------------------------------------------------------
package Raw_Data_Constants is
------------------------------------------------------------------
-- This package contains common constants used to construct
-- X_Raw_Data_Arrays corresponding to various converted values.
------------------------------------------------------------------
subtype Bytes is Xlbmt_Network_Types.X_Raw_Data_Array;
function "&" (L, R : Bytes) return Bytes
renames Xlbmt_Network_Types."&";
function Swab (Data : Bytes) return Bytes renames Swap_Raw_Data;
-- Generic constants
Minus_1 : constant := -1;
-- Single byte constants
--/ if Raw_Is_Unsigned then
Raw_80 : constant Xlbmt_Network_Types.X_Raw_Data := 128;
Raw_Ab : constant Xlbmt_Network_Types.X_Raw_Data := 171;
Raw_Ff : constant Xlbmt_Network_Types.X_Raw_Data := 255;
--/ else
--// Raw_80 : constant X_Raw_Data := -128;
--// Raw_Ab : constant X_Raw_Data := -85;
--// Raw_Ff : constant X_Raw_Data := -1;
--/ end if;
-- Two byte constants
Swab_00_00 : constant Bytes := Swab ((0, 0));
Swab_00_01 : constant Bytes := Swab ((0, 1));
Swab_00_02 : constant Bytes := Swab ((0, 2));
Swab_00_03 : constant Bytes := Swab ((0, 3));
Swab_00_04 : constant Bytes := Swab ((0, 4));
Swab_00_05 : constant Bytes := Swab ((0, 5));
Swab_00_06 : constant Bytes := Swab ((0, 6));
Swab_00_07 : constant Bytes := Swab ((0, 7));
Swab_00_08 : constant Bytes := Swab ((0, 8));
Swab_00_09 : constant Bytes := Swab ((0, 9));
Swab_00_0a : constant Bytes := Swab ((0, 10));
Swab_00_0b : constant Bytes := Swab ((0, 11));
Swab_00_0c : constant Bytes := Swab ((0, 12));
Swab_00_0d : constant Bytes := Swab ((0, 13));
Swab_00_0e : constant Bytes := Swab ((0, 14));
Swab_00_0f : constant Bytes := Swab ((0, 15));
Swab_00_10 : constant Bytes := Swab ((0, 16));
Swab_00_12 : constant Bytes := Swab ((0, 18));
Swab_01_00 : constant Bytes := Swab ((1, 0));
Swab_01_02 : constant Bytes := Swab ((1, 2));
Swab_01_23 : constant Bytes := Swab ((16#01#, 16#23#));
Swab_03_04 : constant Bytes := Swab ((3, 4));
Swab_05_06 : constant Bytes := Swab ((5, 6));
Swab_45_67 : constant Bytes := Swab ((16#45#, 16#67#));
Swab_7f_Ff : constant Bytes := Swab ((16#7F#, Raw_Ff));
Swab_80_00 : constant Bytes := Swab ((Raw_80, 0));
Swab_89_Ab : constant Bytes := Swab ((16#89#, Raw_Ab));
Swab_Ff_Ff : constant Bytes := Swab ((Raw_Ff, Raw_Ff));
-- Four byte constants
Swab_00_00_00_00 : constant Bytes := Swab ((0, 0, 0, 0));
Swab_00_00_00_01 : constant Bytes := Swab ((0, 0, 0, 1));
Swab_00_00_00_02 : constant Bytes := Swab ((0, 0, 0, 2));
Swab_00_00_00_03 : constant Bytes := Swab ((0, 0, 0, 3));
Swab_00_00_00_04 : constant Bytes := Swab ((0, 0, 0, 4));
Swab_00_00_00_05 : constant Bytes := Swab ((0, 0, 0, 5));
Swab_00_00_00_06 : constant Bytes := Swab ((0, 0, 0, 6));
Swab_00_00_00_07 : constant Bytes := Swab ((0, 0, 0, 7));
Swab_00_00_00_08 : constant Bytes := Swab ((0, 0, 0, 8));
Swab_00_00_00_09 : constant Bytes := Swab ((0, 0, 0, 9));
Swab_00_00_00_0a : constant Bytes := Swab ((0, 0, 0, 10));
Swab_00_00_00_0b : constant Bytes := Swab ((0, 0, 0, 11));
Swab_00_00_00_0c : constant Bytes := Swab ((0, 0, 0, 12));
Swab_00_00_00_0d : constant Bytes := Swab ((0, 0, 0, 13));
Swab_00_00_00_0e : constant Bytes := Swab ((0, 0, 0, 14));
Swab_00_00_00_0f : constant Bytes := Swab ((0, 0, 0, 15));
Swab_00_00_00_10 : constant Bytes := Swab ((0, 0, 0, 16));
Swab_00_00_00_11 : constant Bytes := Swab ((0, 0, 0, 17));
Swab_01_23_45_67 : constant Bytes :=
Swab ((16#01#, 16#23#, 16#45#, 16#67#));
Swab_7f_Ff_Ff_Ff : constant Bytes :=
Swab ((16#7F#, Raw_Ff, Raw_Ff, Raw_Ff));
Swab_80_00_00_00 : constant Bytes := Swab ((Raw_80, 0, 0, 0));
Swab_Ff_Ff_Ff_Ff : constant Bytes :=
Swab ((Raw_Ff, Raw_Ff, Raw_Ff, Raw_Ff));
end Raw_Data_Constants;
----------------------------------------------------------------------
package U_Char_Constants is
------------------------------------------------------------------
-- This package contains common constants used to construct
-- U_Char_Arrays corresponding to various converted values.
------------------------------------------------------------------
subtype Bytes is Xlbt_Arithmetic.U_Char_Array;
function "&" (L, R : Bytes) return Bytes renames Xlbt_Arithmetic."&";
function Swab (Data : Bytes) return Bytes renames Swap_U_Char;
-- Generic constants
Minus_1 : constant := -1;
-- Single byte constants
Uca_80 : constant Xlbt_Arithmetic.U_Char := 128;
Uca_Ab : constant Xlbt_Arithmetic.U_Char := 171;
Uca_Ff : constant Xlbt_Arithmetic.U_Char := 255;
-- Two byte constants
Swab_00_00 : constant Bytes := Swab ((0, 0));
Swab_00_01 : constant Bytes := Swab ((0, 1));
Swab_00_02 : constant Bytes := Swab ((0, 2));
Swab_00_03 : constant Bytes := Swab ((0, 3));
Swab_00_04 : constant Bytes := Swab ((0, 4));
Swab_00_05 : constant Bytes := Swab ((0, 5));
Swab_00_06 : constant Bytes := Swab ((0, 6));
Swab_00_07 : constant Bytes := Swab ((0, 7));
Swab_00_08 : constant Bytes := Swab ((0, 8));
Swab_00_09 : constant Bytes := Swab ((0, 9));
Swab_00_0a : constant Bytes := Swab ((0, 10));
Swab_00_0b : constant Bytes := Swab ((0, 11));
Swab_00_0c : constant Bytes := Swab ((0, 12));
Swab_00_0d : constant Bytes := Swab ((0, 13));
Swab_00_0e : constant Bytes := Swab ((0, 14));
Swab_00_0f : constant Bytes := Swab ((0, 15));
Swab_00_10 : constant Bytes := Swab ((0, 16));
Swab_00_12 : constant Bytes := Swab ((0, 18));
Swab_01_00 : constant Bytes := Swab ((1, 0));
Swab_01_02 : constant Bytes := Swab ((1, 2));
Swab_01_23 : constant Bytes := Swab ((16#01#, 16#23#));
Swab_03_04 : constant Bytes := Swab ((3, 4));
Swab_05_06 : constant Bytes := Swab ((5, 6));
Swab_45_67 : constant Bytes := Swab ((16#45#, 16#67#));
Swab_7f_Ff : constant Bytes := Swab ((16#7F#, Uca_Ff));
Swab_80_00 : constant Bytes := Swab ((Uca_80, 0));
Swab_89_Ab : constant Bytes := Swab ((16#89#, Uca_Ab));
Swab_Ff_Ff : constant Bytes := Swab ((Uca_Ff, Uca_Ff));
-- Four byte constants
Swab_00_00_00_00 : constant Bytes := Swab ((0, 0, 0, 0));
Swab_00_00_00_01 : constant Bytes := Swab ((0, 0, 0, 1));
Swab_00_00_00_02 : constant Bytes := Swab ((0, 0, 0, 2));
Swab_00_00_00_03 : constant Bytes := Swab ((0, 0, 0, 3));
Swab_00_00_00_04 : constant Bytes := Swab ((0, 0, 0, 4));
Swab_00_00_00_05 : constant Bytes := Swab ((0, 0, 0, 5));
Swab_00_00_00_06 : constant Bytes := Swab ((0, 0, 0, 6));
Swab_00_00_00_07 : constant Bytes := Swab ((0, 0, 0, 7));
Swab_00_00_00_08 : constant Bytes := Swab ((0, 0, 0, 8));
Swab_00_00_00_09 : constant Bytes := Swab ((0, 0, 0, 9));
Swab_00_00_00_0a : constant Bytes := Swab ((0, 0, 0, 10));
Swab_00_00_00_0b : constant Bytes := Swab ((0, 0, 0, 11));
Swab_00_00_00_0c : constant Bytes := Swab ((0, 0, 0, 12));
Swab_00_00_00_0d : constant Bytes := Swab ((0, 0, 0, 13));
Swab_00_00_00_0e : constant Bytes := Swab ((0, 0, 0, 14));
Swab_00_00_00_0f : constant Bytes := Swab ((0, 0, 0, 15));
Swab_00_00_00_10 : constant Bytes := Swab ((0, 0, 0, 16));
Swab_00_00_00_11 : constant Bytes := Swab ((0, 0, 0, 17));
Swab_01_23_45_67 : constant Bytes :=
Swab ((16#01#, 16#23#, 16#45#, 16#67#));
Swab_7f_Ff_Ff_Ff : constant Bytes :=
Swab ((16#7F#, Uca_Ff, Uca_Ff, Uca_Ff));
Swab_80_00_00_00 : constant Bytes := Swab ((Uca_80, 0, 0, 0));
Swab_Ff_Ff_Ff_Ff : constant Bytes :=
Swab ((Uca_Ff, Uca_Ff, Uca_Ff, Uca_Ff));
end U_Char_Constants;
----------------------------------------------------------------------
package Dummy_Converters is
------------------------------------------------------------------
-- This package is a dummy version of Xlbmp_Generic_Converters
-- and Xlbp_U_Char_Generics. It is used by tests that want to
-- use converters which aren't normally required by the
-- protocol, and thus aren't provided by any of the standard
-- converter packages. The conversion generics here perform no
-- actual work - they just raise Unimplemented so that the test
-- generics will know to ignore this test.
------------------------------------------------------------------
Unimplemented : exception;
--
-- Raised by these conversion routines to signify inapplicable
-- tests.
------------------------------------------------------------------
generic
type Original is (<>);
type Converted is private;
procedure Convert_From_Discrete (Conv : out Converted;
Orig : Original);
generic
type Original is private;
type Converted is private;
procedure Convert_From_Private (Conv : out Converted;
Orig : Original);
generic
type Original is private;
type Index is (<>);
type Original_Array is array (Index range <>) of Original;
type Converted is private;
procedure Convert_From_Array (Conv : out Converted;
Orig : Original_Array);
generic
type Original is private;
type Index1 is (<>);
type Index2 is (<>);
type Original_Array is array (Index1 range <>,
Index2 range <>) of Original;
type Converted is private;
procedure Convert_From_2d_Array (Conv : out Converted;
Orig : Original_Array);
------------------------------------------------------------------
generic
type Original is (<>);
type Converted is private;
procedure Convert_To_Discrete (Orig : out Original;
Conv : Converted);
generic
type Original is private;
type Converted is private;
procedure Convert_To_Private (Orig : out Original;
Conv : Converted);
generic
type Original is private;
type Index is (<>);
type Original_Array is array (Index range <>) of Original;
type Converted is private;
procedure Convert_To_Array (Orig : out Original_Array;
Conv : Converted);
generic
type Original is private;
type Index1 is (<>);
type Index2 is (<>);
type Original_Array is array (Index1 range <>,
Index2 range <>) of Original;
type Converted is private;
procedure Convert_To_2d_Array (Orig : out Original_Array;
Conv : Converted);
end Dummy_Converters;
----------------------------------------------------------------------
end Cvt_Test_Utilities;