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

⟦73e257c43⟧ TextFile

    Length: 5318 (0x14c6)
    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 Xlbp_U_Char_Generics;

--/ if Record_Rep_Clauses then
--// with Xlbmt_Parameters;
--// use Xlbmt_Parameters;
--/ end if;

procedure Cvt_092 is
------------------------------------------------------------------------------
-- Tests for Xlbp_U_Char_Generics
------------------------------------------------------------------------------
-- ****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- * 25-SEP-90 - /DRK/ Created.
-- * 14-NOV-90 - /GEB/ Separate cvt_090 into four parts.
-- ****************************************************************************
------------------------------------------------------------------------------


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

    package Utils renames Cvt_Test_Utilities;  
    package Tests renames Utils.U_Char_Tests;  
    use Utils.U_Char_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;

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

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

    procedure Test_Private_Conversions is  
        procedure To_Uca          is  
           new Xlbp_U_Char_Generics.Convert_Private_To_Uca (Private_48);  
        procedure From_Uca        is  
           new Xlbp_U_Char_Generics.Convert_Uca_To_Private (Private_48);  
        procedure Test_Private_48 is  
           new Tests.Tester (Private_48, "Private_48", To_Uca, From_Uca);

        procedure To_Uca          is  
           new Xlbp_U_Char_Generics.Convert_Private_To_Uca (Private_32);  
        procedure From_Uca        is  
           new Xlbp_U_Char_Generics.Convert_Uca_To_Private (Private_32);  
        procedure Test_Private_32 is  
           new Tests.Tester (Private_32, "Private_32", To_Uca, From_Uca);

        procedure To_Uca          is  
           new Xlbp_U_Char_Generics.Convert_Private_To_Uca (Private_16);  
        procedure From_Uca        is  
           new Xlbp_U_Char_Generics.Convert_Uca_To_Private (Private_16);  
        procedure Test_Private_16 is  
           new Tests.Tester (Private_16, "Private_16", To_Uca, From_Uca);  
    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;

begin  
    Test_Private_Conversions;  
end Cvt_092;