DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

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

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦6f1f4a6d1⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Cvt_131, seg_005505

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Test_Io;  
with Cvt_Test_Utilities;

with Xlbt_Arithmetic;  
with Xlbt_Basic;  
with Xlbt_Color;  
with Xlbt_Gc;  
with Xlbt_Grab;  
with Xlbt_Graphics;  
with Xlbt_Host;  
with Xlbt_Image;  
with Xlbt_Input_Focus;  
with Xlbt_Key;  
with Xlbt_Keyboard;  
with Xlbt_Misc;  
with Xlbt_Pointer;  
with Xlbt_Request;  
with Xlbt_Screen_Saver;  
with Xlbt_Window;  
with Xlbmt_Network_Types;

with Xlbip_Request_Converters;


procedure Cvt_131 is
------------------------------------------------------------------------------
-- Tests for Xlbip_Request_Converters
--
-- Xlbip_Request_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_Raw and From_Raw converters when necessary.
-- ****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- * 18-SEP-90 - /DRK/ Created.
-- *  4-APR-91 - /GEB/ HPUX CDF chokes on the original unit, too big.  Break
-- *           -  it into 12-15 different units.
-- ****************************************************************************
------------------------------------------------------------------------------

--\x0c
---------------------------------
-- Handy constants and renames --
---------------------------------

    package Utils renames Cvt_Test_Utilities;  
    package Tests renames Utils.Raw_Data_Tests;  
    package Dummy renames Utils.Dummy_Converters;  
    use Utils.Raw_Data_Constants;

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

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

--\x0c
    procedure Test_X_Store_Named_Color_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Store_Named_Color_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Store_Named_Color_Request,  
                                  "X_Store_Named_Color_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Store_Named_Color_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, (others => False),  
                    0, (Id => (Number => 0)), 0, 0, 0, 0), (1 .. 16 => 0));  
        Test ("1.2.3.4.5.6.-1", (Xlbt_Request.Create_Window,  
                                 (Xlbt_Color.Do_Green => True, others => False),  
                                 3, (Id => (Number => 4)), 5, 6, 255, 255),  
              ((1, 2)) & Swab_00_03 & Swab_00_00_00_04 &  
                 Swab_00_00_00_05 & Swab_00_06 & Swab_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_X_Store_Named_Color_Request;

--\x0c
    procedure Test_X_Translate_Coords_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Translate_Coords_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Translate_Coords_Request,  
                                  "X_Translate_Coords_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Translate_Coords_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0,  
                    (Drawable => (Id => (Number => 0))),  
                    (Drawable => (Id => (Number => 0))), 0, 0), (1 .. 16 => 0));  
        Test ("1.-1.2.3.4.5.6", (Xlbt_Request.Create_Window, 255, 2,  
                                 (Drawable => (Id => (Number => 3))),  
                                 (Drawable => (Id => (Number => 4))), 5, 6),  
              ((1, Raw_Ff)) & Swab_00_02 & Swab_00_00_00_03 &  
                 Swab_00_00_00_04 & Swab_00_05 & Swab_00_06);  
        Test_Io.New_Line;  
    end Test_X_Translate_Coords_Request;

--\x0c
    procedure Test_X_Ungrab_Button_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Ungrab_Button_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Ungrab_Button_Request,  
                                  "X_Ungrab_Button_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Ungrab_Button_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, Xlbt_Pointer.Any_Button, 0,  
                    (Drawable => (Id => (Number => 0))), (others => False), 0),  
              (1 .. 12 => 0));  
        Test ("1.2.3.4.5.-1",  
              (Xlbt_Request.Create_Window, Xlbt_Pointer.Button_2,  
               3, (Drawable => (Id => (Number => 4))),  
               (Xlbt_Key.Control_Mask | Xlbt_Key.Shift_Mask => True,  
                others => False), 16#FFFF#),  
              ((1, 2)) & Swab_00_03 & Swab_00_00_00_04 &  
                 Swab_00_05 & Swab_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_X_Ungrab_Button_Request;

--\x0c
    procedure Test_X_Ungrab_Key_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Ungrab_Key_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Ungrab_Key_Request,  
                                  "X_Ungrab_Key_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Ungrab_Key_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0,  
                    (Drawable => (Id => (Number => 0))), (others => False), 0),  
              (1 .. 12 => 0));  
        Test ("1.2.3.4.5.-1",  
              (Xlbt_Request.Create_Window, 2, 3,  
               (Drawable => (Id => (Number => 4))),  
               (Xlbt_Key.Control_Mask | Xlbt_Key.Shift_Mask => True,  
                others => False), 16#FFFF#),  
              ((1, 2)) & Swab_00_03 & Swab_00_00_00_04 &  
                 Swab_00_05 & Swab_Ff_Ff);  
        Test_Io.New_Line;  
    end Test_X_Ungrab_Key_Request;

--\x0c
    procedure Test_X_Ungrab_Keyboard_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Ungrab_Keyboard_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Ungrab_Keyboard_Request,  
                                  "X_Ungrab_Keyboard_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Ungrab_Keyboard_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0, 0), (1 .. 8 => 0));  
        Test ("1.-1.2.3", (Xlbt_Request.Create_Window, 255, 2, 3),  
              ((1, Raw_Ff)) & Swab_00_02 & Swab_00_00_00_03);  
        Test_Io.New_Line;  
    end Test_X_Ungrab_Keyboard_Request;

--\x0c
    procedure Test_X_Ungrab_Pointer_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Ungrab_Pointer_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Ungrab_Pointer_Request,  
                                  "X_Ungrab_Pointer_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Ungrab_Pointer_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0, 0), (1 .. 8 => 0));  
        Test ("1.-1.2.3", (Xlbt_Request.Create_Window, 255, 2, 3),  
              ((1, Raw_Ff)) & Swab_00_02 & Swab_00_00_00_03);  
        Test_Io.New_Line;  
    end Test_X_Ungrab_Pointer_Request;

--\x0c
    procedure Test_X_Ungrab_Server_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Ungrab_Server_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Ungrab_Server_Request,  
                                  "X_Ungrab_Server_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Ungrab_Server_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0), (1 .. 4 => 0));  
        Test ("1.-1.2", (Xlbt_Request.Create_Window, 255, 2),  
              ((1, Raw_Ff)) & Swab_00_02);  
        Test_Io.New_Line;  
    end Test_X_Ungrab_Server_Request;

--\x0c
    procedure Test_X_Uninstall_Colormap_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Uninstall_Colormap_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Uninstall_Colormap_Request,  
                                  "X_Uninstall_Colormap_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Uninstall_Colormap_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0, (Id => (Number => 0))),  
              (1 .. 8 => 0));  
        Test ("1.-1.2.3", (Xlbt_Request.Create_Window,  
                           255, 2, (Id => (Number => 3))),  
              ((1, Raw_Ff)) & Swab_00_02 & Swab_00_00_00_03);  
        Test_Io.New_Line;  
    end Test_X_Uninstall_Colormap_Request;

--\x0c
    procedure Test_X_Unmap_Subwindows_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Unmap_Subwindows_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Unmap_Subwindows_Request,  
                                  "X_Unmap_Subwindows_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Unmap_Subwindows_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0,  
                    (Drawable => (Id => (Number => 0)))), (1 .. 8 => 0));  
        Test ("1.-1.2.3", (Xlbt_Request.Create_Window, 255, 2,  
                           (Drawable => (Id => (Number => 3)))),  
              ((1, Raw_Ff)) & Swab_00_02 & Swab_00_00_00_03);  
        Test_Io.New_Line;  
    end Test_X_Unmap_Subwindows_Request;

--\x0c
    procedure Test_X_Unmap_Window_Request is  
        procedure From_Raw is new Dummy.Convert_To_Private  
                                     (Xlbt_Request.X_Unmap_Window_Request,  
                                      Xlbmt_Network_Types.X_Raw_Data_Array);  
        procedure Test is new Tests.Tester  
                                 (Xlbt_Request.X_Unmap_Window_Request,  
                                  "X_Unmap_Window_Request",  
                                  Xlbip_Request_Converters.To_Raw, From_Raw);  
    begin  
        Test_Io.Section ("X_Unmap_Window_Request conversions");  
        Test ("0", (Xlbt_Request.Invalid_Request, 0, 0,  
                    (Drawable => (Id => (Number => 0)))), (1 .. 8 => 0));  
        Test ("1.-1.2.3", (Xlbt_Request.Create_Window, 255, 2,  
                           (Drawable => (Id => (Number => 3)))),  
              ((1, Raw_Ff)) & Swab_00_02 & Swab_00_00_00_03);  
        Test_Io.New_Line;  
    end Test_X_Unmap_Window_Request;

--\x0c
begin

    Test_X_Store_Named_Color_Request;  
    Test_X_Translate_Coords_Request;  
    Test_X_Ungrab_Button_Request;  
    Test_X_Ungrab_Key_Request;  
    Test_X_Ungrab_Keyboard_Request;  
    Test_X_Ungrab_Pointer_Request;  
    Test_X_Ungrab_Server_Request;  
    Test_X_Uninstall_Colormap_Request;  
    Test_X_Unmap_Subwindows_Request;  
    Test_X_Unmap_Window_Request;

end Cvt_131;  

E3 Meta Data

    nblk1=e
    nid=0
    hdr6=1c
        [0x00] rec0=23 rec1=00 rec2=01 rec3=03e
        [0x01] rec0=1b rec1=00 rec2=02 rec3=0a2
        [0x02] rec0=10 rec1=00 rec2=03 rec3=03e
        [0x03] rec0=11 rec1=00 rec2=04 rec3=08e
        [0x04] rec0=13 rec1=00 rec2=05 rec3=01a
        [0x05] rec0=13 rec1=00 rec2=06 rec3=066
        [0x06] rec0=15 rec1=00 rec2=07 rec3=026
        [0x07] rec0=12 rec1=00 rec2=08 rec3=02c
        [0x08] rec0=12 rec1=00 rec2=09 rec3=082
        [0x09] rec0=13 rec1=00 rec2=0a rec3=032
        [0x0a] rec0=13 rec1=00 rec2=0b rec3=010
        [0x0b] rec0=12 rec1=00 rec2=0c rec3=052
        [0x0c] rec0=1a rec1=00 rec2=0d rec3=00c
        [0x0d] rec0=01 rec1=00 rec2=0e rec3=000
    tail 0x21500a1de81978b2186ca 0x42a00088462063203