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: ┃ B T ┃
Length: 14548 (0x38d4) Types: TextFile Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00 └─ ⟦0c20f784e⟧ »DATA« └─⟦1abbe589f⟧ └─⟦49e7f20b9⟧ └─⟦this⟧
with Test_Io; with Cvt_Test_Utilities; with Xlbt_Arithmetic; with Xlbmt_Network_Types; with Xlbmp_Generic_Converters; --/ if Record_Rep_Clauses then --// with Xlbmt_Parameters; --// use Xlbmt_Parameters; --/ end if; procedure Cvt_010 is ------------------------------------------------------------------------------ -- Tests for Xlbmp_Generic_Converters ------------------------------------------------------------------------------ -- 09/05/90 DRK | Created. ------------------------------------------------------------------------------ --------------------------------- -- Handy constants and renames -- --------------------------------- package Utils renames Cvt_Test_Utilities; package Tests renames Utils.Raw_Data_Tests; use Utils.Raw_Data_Constants; ---------------------------------------------------------------------- ----------------- -- Local types -- ----------------- type Discrete_S32 is new Xlbt_Arithmetic.S_Long; type Discrete_S16 is new Xlbt_Arithmetic.S_Short; type Discrete_U16 is new Xlbt_Arithmetic.U_Short; type Discrete_S8 is new Xlbt_Arithmetic.S_Char; type Discrete_U8 is new Xlbt_Arithmetic.U_Char; type Private_48 is record Value_1 : Discrete_S16; Value_2 : Discrete_S16; Value_3 : Discrete_S16; end record; --/ if Length_Clauses then for Private_48'Size use 48; --/ end if; --/ if Record_Rep_Clauses then --// for Private_48 use --// record --// Value_1 at 0 * X_Word range X_Half0a .. X_Half0b; --// Value_2 at 0 * X_Word range X_Half1a .. X_Half1b; --// Value_3 at 1 * X_Word range X_Half0a .. X_Half0b; --// end record; --/ end if; type Private_32 is record Value : Discrete_S32; end record; --/ if Length_Clauses then for Private_32'Size use 32; --/ end if; type Private_16 is record Value : Discrete_S16; end record; --/ if Length_Clauses then for Private_16'Size use 16; --/ end if; type Array_S8_Of_U16 is array (Discrete_S8 range <>) of Discrete_U16; --/ if Pack then --// pragma Pack (Array_S8_Of_U16); --/ end if; type Array_U16_Of_S8 is array (Discrete_U16 range <>) of Discrete_S8; --/ if Pack then --// pragma Pack (Array_U16_Of_S8); --/ end if; type Array_S16_U16_Of_S8 is array (Discrete_S16 range <>, Discrete_U16 range <>) of Discrete_S8; --/ if Pack then --// pragma Pack (Array_S16_U16_Of_S8); --/ end if; ---------------------------------------------------------------------- ------------------------- -- Major test sections -- ------------------------- procedure Test_Discrete_Conversions is procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_S32); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_S32); procedure Test_Discrete_S32 is new Tests.Tester (Discrete_S32, "Discrete_S32", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_S16); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_S16); procedure Test_Discrete_S16 is new Tests.Tester (Discrete_S16, "Discrete_S16", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_S8); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_S8); procedure Test_Discrete_S8 is new Tests.Tester (Discrete_S8, "Discrete_S8", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_U16); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_U16); procedure Test_Discrete_U16 is new Tests.Tester (Discrete_U16, "Discrete_U16", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_U8); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_U8); procedure Test_Discrete_U8 is new Tests.Tester (Discrete_U8, "Discrete_U8", To_Raw, From_Raw); begin Test_Io.Section ("Converting discrete types"); Test_Discrete_S32 ("16#0000_0000#", 0, (1 .. 4 => 16#00#)); Test_Discrete_S32 ("16#0000_0001#", 1, Swab_00_00_00_01); Test_Discrete_S32 ("16#FFFF_FFFF#", -1, Swab_Ff_Ff_Ff_Ff); Test_Discrete_S32 ("16#8000_0000#", Discrete_S32'First, Swab_80_00_00_00); Test_Discrete_S32 ("16#7FFF_FFFF#", Discrete_S32'Last, Swab_7f_Ff_Ff_Ff); Test_Discrete_S32 ("16#0123_4567#", 16#0123_4567#, Swab_01_23_45_67); Test_Io.New_Line; Test_Discrete_S16 ("16#0000#", 0, Swab_00_00); Test_Discrete_S16 ("16#0001#", 1, Swab_00_01); Test_Discrete_S16 ("16#FFFF#", -1, Swab_Ff_Ff); Test_Discrete_S16 ("16#8000#", Discrete_S16'First, Swab_80_00); Test_Discrete_S16 ("16#7FFF#", Discrete_S16'Last, Swab_7f_Ff); Test_Discrete_S16 ("16#0123#", 16#0123#, Swab_01_23); Test_Io.New_Line; Test_Discrete_S8 ("16#00#", 0, (1 => 16#00#)); Test_Discrete_S8 ("16#01#", 1, (1 => 16#01#)); Test_Discrete_S8 ("16#FF#", -1, (1 => Raw_Ff)); Test_Discrete_S8 ("16#80#", Discrete_S8'First, (1 => Raw_80)); Test_Discrete_S8 ("16#7F#", Discrete_S8'Last, (1 => 16#7F#)); Test_Io.New_Line; Test_Discrete_U16 ("16#0000#", 0, Swab_00_00); Test_Discrete_U16 ("16#0001#", 1, Swab_00_01); Test_Discrete_U16 ("16#FFFF#", Discrete_U16'Last, Swab_Ff_Ff); Test_Discrete_U16 ("16#8000#", 16#8000#, Swab_80_00); Test_Discrete_U16 ("16#7FFF#", 16#7FFF#, Swab_7f_Ff); Test_Discrete_U16 ("16#0123#", 16#0123#, Swab_01_23); Test_Io.New_Line; Test_Discrete_U8 ("16#00#", 0, (1 => 16#00#)); Test_Discrete_U8 ("16#01#", 1, (1 => 16#01#)); Test_Discrete_U8 ("16#FF#", Discrete_U8'Last, (1 => Raw_Ff)); Test_Discrete_U8 ("16#7F#", 127, (1 => 16#7F#)); Test_Discrete_U8 ("16#80#", 128, (1 => 16#80#)); Test_Io.New_Line; end Test_Discrete_Conversions; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- procedure Test_Private_Conversions is procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Private_To_Raw (Private_48); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Private (Private_48); procedure Test_Private_48 is new Tests.Tester (Private_48, "Private_48", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Private_To_Raw (Private_32); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Private (Private_32); procedure Test_Private_32 is new Tests.Tester (Private_32, "Private_32", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Private_To_Raw (Private_16); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Private (Private_16); procedure Test_Private_16 is new Tests.Tester (Private_16, "Private_16", To_Raw, From_Raw); begin Test_Io.Section ("Converting private types"); Test_Private_48 ("16#0000_0000_0000#", (0, 0, 0), (1 .. 6 => 16#00#)); Test_Private_48 ("16#0000_0000_0001#", (0, 0, 1), Swab_00_00 & Swab_00_00 & Swab_00_01); Test_Private_48 ("16#FFFF_FFFF_FFFF#", (-1, -1, -1), Swab_Ff_Ff & Swab_Ff_Ff & Swab_Ff_Ff); Test_Private_48 ("16#0123_4567_89AB#", (16#0123#, 16#4567#, -30293), Swab_01_23 & Swab_45_67 & Swab_89_Ab); Test_Io.New_Line; Test_Private_32 ("16#0000_0000#", (Value => 0), Swab_00_00_00_00); Test_Private_32 ("16#0000_0001#", (Value => 1), Swab_00_00_00_01); Test_Private_32 ("16#FFFF_FFFF#", (Value => -1), Swab_Ff_Ff_Ff_Ff); Test_Private_32 ("16#8000_0000#", (Value => Discrete_S32'First), Swab_80_00_00_00); Test_Private_32 ("16#7FFF_FFFF#", (Value => Discrete_S32'Last), Swab_7f_Ff_Ff_Ff); Test_Private_32 ("16#0123_4567#", (Value => 16#0123_4567#), Swab_01_23_45_67); Test_Io.New_Line; Test_Private_16 ("16#0000#", (Value => 0), Swab_00_00); Test_Private_16 ("16#0001#", (Value => 1), Swab_00_01); Test_Private_16 ("16#FFFF#", (Value => -1), Swab_Ff_Ff); Test_Private_16 ("16#8000#", (Value => Discrete_S16'First), Swab_80_00); Test_Private_16 ("16#7FFF#", (Value => Discrete_S16'Last), Swab_7f_Ff); Test_Private_16 ("16#0123#", (Value => 16#0123#), Swab_01_23); Test_Io.New_Line; end Test_Private_Conversions; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- procedure Test_Array_Conversions is procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Array_To_Raw (Discrete_U16, Discrete_S8, Array_S8_Of_U16); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Array (Discrete_U16, Discrete_S8, Array_S8_Of_U16); procedure Test_Array_S8_Of_U16 is new Tests.Tester_1d (Discrete_U16, Discrete_S8, Array_S8_Of_U16, "Array_S8_Of_U16", To_Raw, From_Raw); procedure To_Raw is new Xlbmp_Generic_Converters.Convert_Array_To_Raw (Discrete_S8, Discrete_U16, Array_U16_Of_S8); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_Array (Discrete_S8, Discrete_U16, Array_U16_Of_S8); procedure Test_Array_U16_Of_S8 is new Tests.Tester_1d (Discrete_S8, Discrete_U16, Array_U16_Of_S8, "Array_U16_Of_S8", To_Raw, From_Raw); begin Test_Io.Section ("Converting array types"); Test_Array_S8_Of_U16 ("1..0 => 0", (1 .. 0 => 16#0000#), (1 .. 0 => 16#00#)); Test_Array_S8_Of_U16 ("9..-4 => 0", (9 .. -4 => 16#0000#), (1 .. 0 => 16#00#)); Test_Array_S8_Of_U16 ("1..1 => 16#0000#", (1 => 16#0000#), (1 .. 2 => 16#00#)); Test_Array_S8_Of_U16 ("0..0 => 16#0001#", (0 => 16#0001#), Swab_00_01); Test_Array_S8_Of_U16 ("16#0123#, 16#4567#", (16#0123#, 16#4567#), Swab_01_23 & Swab_45_67); Test_Array_S8_Of_U16 ("127 => 16#FFFF#", (127 => 16#FFFF#), Swab_Ff_Ff); Test_Array_S8_Of_U16 ("-5..-3 => 16#5555#", (-5 .. -3 => 16#5555#), (1 .. 6 => 16#55#)); Test_Io.New_Line; Test_Array_U16_Of_S8 ("1..0 => 0", (1 .. 0 => 16#00#), (1 .. 0 => 16#00#)); Test_Array_U16_Of_S8 ("9..-4 => 0", (9 .. -4 => 16#00#), (1 .. 0 => 16#00#)); Test_Array_U16_Of_S8 ("1..1 => 16#00#", (1 => 16#00#), (1 => 16#00#)); Test_Array_U16_Of_S8 ("0..0 => 16#01#", (0 => 16#01#), (1 => 16#01#)); Test_Array_U16_Of_S8 ("16#01#, 16#23#, 16#45#, 16#67#", (16#01#, 16#23#, 16#45#, 16#67#), (16#01#, 16#23#, 16#45#, 16#67#)); Test_Array_U16_Of_S8 ("65535 => 16#FF#", (65535 => -1), (1 => Raw_Ff)); Test_Io.New_Line; end Test_Array_Conversions; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- procedure Test_2d_Array_Conversions is procedure To_Raw is new Xlbmp_Generic_Converters.Convert_2d_Array_To_Raw (Discrete_S8, Discrete_S16, Discrete_U16, Array_S16_U16_Of_S8); procedure From_Raw is new Xlbmp_Generic_Converters.Convert_Raw_To_2d_Array (Discrete_S8, Discrete_S16, Discrete_U16, Array_S16_U16_Of_S8); procedure Test_Array_S16_U16_Of_S8 is new Tests.Tester_2d (Discrete_S8, Discrete_S16, Discrete_U16, Array_S16_U16_Of_S8, "Array_S16_U16_Of_S8", To_Raw, From_Raw); begin Test_Io.Section ("Converting 2d array types"); Test_Array_S16_U16_Of_S8 ("1..0 => (1..0 => 0)", (1 .. 0 => (1 .. 0 => 0)), (1 .. 0 => 16#00#)); Test_Array_S16_U16_Of_S8 ("9..-4 => (1..1 => 0)", (9 .. -4 => (1 .. 1 => 0)), (1 .. 0 => 16#00#)); Test_Array_S16_U16_Of_S8 ("1..1 => (9..-4 => 0)", (1 .. 1 => (9 .. -4 => 0)), (1 .. 0 => 16#00#)); Test_Array_S16_U16_Of_S8 ("1..1 => (1..1 => 16#01#)", (1 => (1 => 16#01#)), (1 => 16#01#)); Test_Array_S16_U16_Of_S8 ("0..0 => (0..0 => 16#02#)", (0 => (0 => 16#02#)), (1 => 16#02#)); Test_Array_S16_U16_Of_S8 ("(1, 2, 3), (4, 5, 6)", ((1, 2, 3), (4, 5, 6)), (1, 2, 3, 4, 5, 6)); Test_Array_S16_U16_Of_S8 ("127 => (255 => 16#FF#)", (127 => (255 => -1)), (1 => Raw_Ff)); Test_Array_S16_U16_Of_S8 ("-5..-3 => (0..1 => 16#80#)", (-5 .. -3 => (0 .. 1 => -128)), (1 .. 6 => Raw_80)); Test_Io.New_Line; end Test_2d_Array_Conversions; begin Test_Discrete_Conversions; Test_Private_Conversions; Test_Array_Conversions; Test_2d_Array_Conversions; end Cvt_010;