DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦1b9a6dfdd⟧ TextFile

    Length: 19613 (0x4c9d)
    Types: TextFile
    Names: »B«

Derivation

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦49e7f20b9⟧ 
                └─⟦this⟧ 

TextFile

with Test_Io;  
with Cvt_Test_Utilities;

with Xlbt_Arithmetic;  
with Xlbt_Basic;  
with Xlbt_Hint;  
with Xlbit_Hint3;  
with Xlbt_Misc;  
with Xlbt_String;  
with Xlbt_String16;

with Xlbp_U_Char_Converters;


procedure Cvt_100 is
------------------------------------------------------------------------------
-- Tests for Xlbp_U_Char_Converters
--
-- Xlbip_U_Char_Converters only instantiates the converters actually used
-- by the protocol.  The Tester generics expect to have symmetric
-- converters for each type.  Individual tests instantiate their own
-- dummy To_Uca and From_Uca converters when necessary.
------------------------------------------------------------------------------
-- 09/25/90 DRK     | Created.
------------------------------------------------------------------------------

    ---------------------------------
    -- Handy constants and renames --
    ---------------------------------

    package Utils renames Cvt_Test_Utilities;  
    package Tests renames Utils.U_Char_Tests;  
    package Dummy renames Utils.Dummy_Converters;  
    use Utils.U_Char_Constants;

    ----------------------------------------------------------------------

    -------------------------
    -- Major test sections --
    -------------------------

    procedure Test_X_Atom_Array is  
        procedure Test is new Tests.Tester_1d  
                                 (Xlbt_Basic.X_Atom, Xlbt_Arithmetic.S_Natural,  
                                  Xlbt_Basic.X_Atom_Array, "X_Atom_Array",  
                                  Xlbp_U_Char_Converters.To_Uca,  
                                  Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Atom_Array conversions");  
        Test ("1..0 => 0", (1 .. 0 => (Number => 0)), (1 .. 0 => 0));  
        Test ("2..2 => -1", (2 => (Number => Minus_1)), (1 .. 4 => Uca_Ff));  
        Test ("0..0 => 2", (0 => (Number => 2)), Swab_00_00_00_02);  
        Test ("1..2 => 1", (1 .. 2 => (Number => 1)),  
              Swab_00_00_00_01 & Swab_00_00_00_01);  
        Test_Io.New_Line;  
    end Test_X_Atom_Array;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Icon_Size_Array is  
        procedure Test is new Tests.Tester_1d (Xlbt_Hint.X_Icon_Size,  
                                               Xlbt_Arithmetic.S_Natural,  
                                               Xlbt_Hint.X_Icon_Size_Array,  
                                               "X_Icon_Size_Array",  
                                               Xlbp_U_Char_Converters.To_Uca,  
                                               Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Icon_Size_Array conversions");  
        Test ("1..0 => 0", (1 .. 0 => (0, 0, 0, 0, 0, 0)), (1 .. 0 => 0));  
        Test ("2..2 => 1.2.3.4.5.6", (2 => (1, 2, 3, 4, 5, 6)),  
              Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &  
                 Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06);  
        Test ("0..0 => 1", (0 => (0, 0, 0, 0, 0, 1)),  
              (1 .. 20 => 0) & Swab_00_00_00_01);  
        Test ("1, 2", ((0, 0, 0, 0, 0, 1), (0, 0, 0, 0, 0, 2)),  
              (1 .. 20 => 0) & Swab_00_00_00_01 &  
                 (1 .. 20 => 0) & Swab_00_00_00_02);  
        Test_Io.New_Line;  
    end Test_X_Icon_Size_Array;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Size_Hints_Protocol is  
        procedure Test is new Tests.Tester (Xlbit_Hint3.X_Size_Hints_Protocol,  
                                            "X_Size_Hints_Protocol",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Size_Hints_Protocol conversions");  
        Test ("0", ((others => False), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,  
                    (0, 0), (0, 0), 0, 0, Xlbit_Hint3.Unmap_Gravity),  
              (1 .. 72 => 0));  
        Test ("1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.1",  
              ((Xlbt_Hint.U_S_Position => True, others => False),  
               2, 3, 4, 5, 6, 7, 8, 9, 10, 11, (0, 12), (0, 13),  
               14, 15, Xlbit_Hint3.North_West_Gravity),  
              Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &  
                 Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &  
                 Swab_00_00_00_07 & Swab_00_00_00_08 & Swab_00_00_00_09 &  
                 Swab_00_00_00_0a & Swab_00_00_00_0b &  
                 (Swab_00_00_00_00 & Swab_00_00_00_0c) &  
                 (Swab_00_00_00_00 & Swab_00_00_00_0d) & Swab_00_00_00_0e &  
                 Swab_00_00_00_0f & Swab_00_00_00_01);  
        Test_Io.New_Line;  
    end Test_X_Size_Hints_Protocol;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Standard_Colormap is  
        procedure To_Uca is new Dummy.Convert_From_Private  
                                   (Xlbt_Hint.X_Standard_Colormap,  
                                    Xlbt_Arithmetic.U_Char_Array);  
        procedure Test   is new Tests.Tester (Xlbt_Hint.X_Standard_Colormap,  
                                              "X_Standard_Colormap", To_Uca,  
                                              Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Standard_Colormap conversions");  
        Test ("0", ((Id => (Number => 0)), 0, 0, 0, 0, 0,  
                    0, 0, (Number => 0), (Number => 0)), (1 .. 40 => 0));  
        Test ("1.2.3.4.5.6.7.8.9.10", ((Id => (Number => 1)), 2, 3, 4, 5, 6,  
                                       7, 8, (Number => 9), (Number => 10)),  
              Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &  
                 Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &  
                 Swab_00_00_00_07 & Swab_00_00_00_08 &  
                 Swab_00_00_00_09 & Swab_00_00_00_0a);  
        Test_Io.New_Line;  
    end Test_X_Standard_Colormap;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Standard_Colormap_Array is  
        procedure From_Uca is new Dummy.Convert_To_Array  
                                     (Xlbt_Hint.X_Standard_Colormap,  
                                      Xlbt_Arithmetic.S_Natural,  
                                      Xlbt_Hint.X_Standard_Colormap_Array,  
                                      Xlbt_Arithmetic.U_Char_Array);  
        procedure Test     is new Tests.Tester_1d  
                                     (Xlbt_Hint.X_Standard_Colormap,  
                                      Xlbt_Arithmetic.S_Natural,  
                                      Xlbt_Hint.X_Standard_Colormap_Array,  
                                      "X_Standard_Colormap_Array",  
                                      Xlbp_U_Char_Converters.To_Uca, From_Uca);  
    begin  
        Test_Io.Section ("X_Standard_Colormap_Array conversions");  
        Test ("1..0 => 0", (1 .. 0 => Xlbt_Hint.None_X_Standard_Colormap),  
              (1 .. 0 => 0));  
        Test ("2..2 => -1", (2 =>  
                                ((Id => (Number => Minus_1)), Minus_1, Minus_1,  
                                 Minus_1, Minus_1, Minus_1, Minus_1, Minus_1,  
                                 (Number => Minus_1), (Number => Minus_1))),  
              (1 .. 40 => Uca_Ff));  
        Test ("0..0 => 1.2.3.4.5.6.7.8.9.10",  
              (0 => ((Id => (Number => 1)), 2, 3, 4, 5, 6,  
                     7, 8, (Number => 9), (Number => 10))),  
              Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &  
                 Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &  
                 Swab_00_00_00_07 & Swab_00_00_00_08 &  
                 Swab_00_00_00_09 & Swab_00_00_00_0a);  
        Test ("1, 2", (((Id => (Number => 0)), 0, 0, 0, 0, 0,  
                        0, 0, (Number => 0), (Number => 1)),  
                       ((Id => (Number => 0)), 0, 0, 0, 0, 0,  
                        0, 0, (Number => 0), (Number => 2))),  
              (1 .. 36 => 0) & Swab_00_00_00_01 &  
                 (1 .. 36 => 0) & Swab_00_00_00_02);  
        Test_Io.New_Line;  
    end Test_X_Standard_Colormap_Array;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Window is  
        procedure Test is new Tests.Tester (Xlbt_Basic.X_Window, "X_Window",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Window conversions");  
        Test ("0", (Drawable => (Id => (Number => 0))), Swab_00_00_00_00);  
        Test ("1", (Drawable => (Id => (Number => 1))), Swab_00_00_00_01);  
        Test ("-1", (Drawable => (Id => (Number => Minus_1))),  
              Swab_Ff_Ff_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_X_Window;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Window_Array is  
        procedure To_Uca is new Dummy.Convert_From_Array  
                                   (Xlbt_Basic.X_Window,  
                                    Xlbt_Arithmetic.S_Natural,  
                                    Xlbt_Basic.X_Window_Array,  
                                    Xlbt_Arithmetic.U_Char_Array);  
        procedure Test is new Tests.Tester_1d (Xlbt_Basic.X_Window,  
                                               Xlbt_Arithmetic.S_Natural,  
                                               Xlbt_Basic.X_Window_Array,  
                                               "X_Window_Array", To_Uca,  
                                               Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Window_Array conversions");  
        Test ("1..0 => 0", (1 .. 0 => (Drawable => (Id => (Number => 0)))),  
              (1 .. 0 => 0));  
        Test ("2..2 => -1", (2 => (Drawable => (Id => (Number => Minus_1)))),  
              (1 .. 4 => Uca_Ff));  
        Test ("0..0 => 1", (0 => (Drawable => (Id => (Number => 1)))),  
              Swab_00_00_00_01);  
        Test ("1, 2", ((Drawable => (Id => (Number => 1))),  
                       (Drawable => (Id => (Number => 2)))),  
              Swab_00_00_00_01 & Swab_00_00_00_02);  
        Test_Io.New_Line;  
    end Test_X_Window_Array;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_Wm_Hints is  
        procedure Test is new Tests.Tester (Xlbt_Hint.X_Wm_Hints, "X_Wm_Hints",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("X_Wm_Hints conversions");  
        Test ("0", Xlbt_Hint.None_X_Wm_Hints, (1 .. 36 => 0));  
        Test ("1.1.3.4.5.6.7.8.9",  
              ((Xlbt_Hint.Input_Hint => True, others => False), Xlbt_Misc.True,  
               Xlbt_Hint.Iconic_State, (Drawable => (Id => (Number => 4))),  
               (Drawable => (Id => (Number => 5))), 6,  
               7, (Drawable => (Id => (Number => 8))),  
               (Drawable => (Id => (Number => 9)))),  
              Swab_00_00_00_01 & Swab_00_00_00_01 & Swab_00_00_00_03 &  
                 Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &  
                 Swab_00_00_00_07 & Swab_00_00_00_08 & Swab_00_00_00_09);  
        Test_Io.New_Line;  
    end Test_X_Wm_Hints;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_S_Char is  
        procedure Test is new Tests.Tester (Xlbt_Arithmetic.S_Char, "S_Char",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("S_Char conversions");  
        Test ("0", 0, (1 => 0));  
        Test ("1", 1, (1 => 1));  
        Test ("-1", Minus_1, (1 => 255));  
        Test_Io.New_Line;  
    end Test_S_Char;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_S_Short is  
        procedure Test is new Tests.Tester (Xlbt_Arithmetic.S_Short, "S_Short",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("S_Short conversions");  
        Test ("0", 0, Swab_00_00);  
        Test ("1", 1, Swab_00_01);  
        Test ("-1", Minus_1, Swab_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_S_Short;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_S_Long is  
        procedure Test is new Tests.Tester (Xlbt_Arithmetic.S_Long, "S_Long",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("S_Long conversions");  
        Test ("0", 0, Swab_00_00_00_00);  
        Test ("1", 1, Swab_00_00_00_01);  
        Test ("-1", Minus_1, Swab_Ff_Ff_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_S_Long;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_U_Short is  
        procedure Test is new Tests.Tester (Xlbt_Arithmetic.U_Short, "U_Short",  
                                            Xlbp_U_Char_Converters.To_Uca,  
                                            Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("U_Short conversions");  
        Test ("0", 0, Swab_00_00);  
        Test ("1", 1, Swab_00_01);  
        Test ("-1", 16#FFFF#, Swab_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_U_Short;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_String is  
        procedure Test is new Tests.Tester_1d  
                                 (Character, Positive, String, "String",  
                                  Xlbp_U_Char_Converters.To_Uca,  
                                  Xlbp_U_Char_Converters.From_Uca);

        procedure Dummy_To_Uca is new Dummy.Convert_From_Array  
                                         (Character, Positive, String,  
                                          Xlbt_Arithmetic.U_Char_Array);  
        procedure Test_Chop    is new Tests.Tester_1d  
                                         (Character, Positive, String,  
                                          "String", Dummy_To_Uca,  
                                          Xlbp_U_Char_Converters.From_Uca);  
    begin  
        Test_Io.Section ("String conversions");  
        Test ("1..0 => 0", (1 .. 0 => Ascii.Nul), (1 .. 0 => 0));  
        Test ("2..2 => 127", (2 => Ascii.Del), (1 => 127));  
        Test ("Abc", "Abc", (65, 98, 99));

        -- Verify that high bits are chopped in Uca data.
        Test_Chop ("big-chars", Ascii.Nul & Ascii.Del & '+' & Ascii.Del,  
                   (Uca_80, 16#7F#, Uca_Ab, Uca_Ff));  
        Test_Io.New_Line;  
    end Test_String;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_String_Trans is  
        Trans : Xlbp_U_Char_Converters.U_Character_Array := (others => '?');

        procedure Trans_From_Uca (Str : out String;  
                                  Uca :     Xlbt_Arithmetic.U_Char_Array) is  
        begin  
            Xlbp_U_Char_Converters.From_Uca (Str, Uca, Trans);  
        end Trans_From_Uca;

        procedure Test is new Tests.Tester_1d  
                                 (Character, Positive, String, "String",  
                                  Xlbp_U_Char_Converters.To_Uca,  
                                  Test_String_Trans.Trans_From_Uca);

        procedure Dummy_To_Uca is new Dummy.Convert_From_Array  
                                         (Character, Positive, String,  
                                          Xlbt_Arithmetic.U_Char_Array);  
        procedure Test_Trans   is  
           new Tests.Tester_1d (Character, Positive, String, "String",  
                                Dummy_To_Uca, Test_String_Trans.Trans_From_Uca);  
    begin  
        Test_Io.Section ("String translation conversions");

        -- Let normal characters translate normally.
        for I in Character'First .. Character'Last loop  
            Trans (Character'Pos (I)) := I;  
        end loop;

        -- Test normal translations.
        Test ("1..0 => 0", (1 .. 0 => Ascii.Nul), (1 .. 0 => 0));  
        Test ("2..2 => 127", (2 => Ascii.Del), (1 => 127));  
        Test ("Abc", "Abc", (65, 98, 99));

        -- Verify that translation works.
        Trans (Uca_80) := 'w';  
        Trans (16#7F#) := 'x';  
        Trans (Uca_Ab) := 'y';  
        Trans (Uca_Ff) := 'z';  
        Test_Trans ("big-chars", "<wxyz>",  
                    (60, Uca_80, 16#7F#, Uca_Ab, Uca_Ff, 62));  
        Test_Io.New_Line;  
    end Test_String_Trans;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_String is  
        procedure Test is new Tests.Tester_1d (Xlbt_String.X_Character,  
                                               Xlbt_Arithmetic.S_Natural,  
                                               Xlbt_String.X_String, "X_String",  
                                               Xlbp_U_Char_Converters.To_Uca,  
                                               Xlbp_U_Char_Converters.From_Uca);  
        use Xlbt_String;  
    begin  
        Test_Io.Section ("X_String conversions");  
        Test ("1..0 => 0", (1 .. 0 => Xlbt_String.Nul), (1 .. 0 => 0));  
        Test ("2..2 => 255", (2 => Xlbt_String.C255), (1 => Uca_Ff));  
        Test ("0..0 => 1", (0 => Xlbt_String.Soh), (1 => 1));  
        Test ("Abc", "Abc", (65, 98, 99));  
        Test_Io.New_Line;  
    end Test_X_String;

    --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    procedure Test_X_String16 is  
        procedure Test is new Tests.Tester_1d  
                                 (Xlbt_String16.X_Character16,  
                                  Xlbt_Arithmetic.S_Natural,  
                                  Xlbt_String16.X_String16, "X_String16",  
                                  Xlbp_U_Char_Converters.To_Uca,  
                                  Xlbp_U_Char_Converters.From_Uca);
        -- The protocol says a STRING16 is a list of CHAR2B's, and
        -- stipulates that CHAR2Bs are NOT byte-swapped.  They are
        -- always sent Most-Significant-Byte first.
    begin  
        Test_Io.Section ("X_String16 conversions");  
        Test ("1..0 => 0", (1 .. 0 => (0, 0)), (1 .. 0 => 0));  
        Test ("2..2 => -1", (2 => (255, 255)), (Uca_Ff, Uca_Ff));  
        Test ("0..0 => 1", (0 => (0, 1)), (0, 1));  
        Test ("1.2, 3.4, 5.6", ((1, 2), (3, 4), (5, 6)), (1, 2, 3, 4, 5, 6));  
        Test_Io.New_Line;  
    end Test_X_String16;

begin  
    Test_X_Atom_Array;  
    Test_X_Icon_Size_Array;  
    Test_X_Size_Hints_Protocol;  
    Test_X_Standard_Colormap;  
    Test_X_Standard_Colormap_Array;  
    Test_X_Window;  
    Test_X_Window_Array;  
    Test_X_Wm_Hints;  
    Test_S_Char;  
    Test_S_Short;  
    Test_S_Long;  
    Test_U_Short;  
    Test_String;  
    Test_String_Trans;  
    Test_X_String;  
    Test_X_String16;  
end Cvt_100;