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

⟦e35f894bb⟧ TextFile

    Length: 9288 (0x2448)
    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;  
use Test_Io;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Rm3;  
use Xlbt_Rm3;  
with Xlbt_String;  
use Xlbt_String;

with Xlbp_Rm_Name;  
use Xlbp_Rm_Name;

with Xlbit_Library3;  
use Xlbit_Library3;

with Xlbmp_Debugger;

procedure Rm_020 is
------------------------------------------------------------------------------
-- Tests for Xlbp_Rm_Name.
------------------------------------------------------------------------------
-- 07/05/90 GEB     | Created.
------------------------------------------------------------------------------

    function Class_Id (C : X_Rm_Class) return S_Long is  
    begin  
        return C.Id;  
    end Class_Id;

    function Name_Id (N : X_Rm_Name) return S_Long is  
    begin  
        return N.Id;  
    end Name_Id;

    function Representation_Id (R : X_Rm_Representation) return S_Long is  
    begin  
        return R.Id;  
    end Representation_Id;

    generic  
        What : String;  
        type Quark is private;  
        None : Quark;  
        type Quark_Array is array (S_Natural range <>) of Quark;  
        with function  To_Quark  (Name     : X_String;  
                                  Validate : Boolean) return Quark;  
        with function  To_String (Q : Quark)          return X_String;  
        with procedure To_Ql     (List : X_String; Ql : out Quark_Array);  
        with procedure To_Bql    (List :     X_String;  
                                  Bl   : out X_Rm_Binding_Array;  
                                  Ql   : out Quark_Array);  
        with function  Unique                         return Quark;  
        with function  To_Id     (Q : Quark)          return S_Long;  
    procedure Test_One_Type;

    procedure Test_One_Type is

        Quark1     : Quark;  
        Quark_List : Quark_Array (1 .. 10);  
        Bind_List  : X_Rm_Binding_Array (1 .. 10);

        procedure Qts (Name : X_String) is
------------------------------------------------------------------------------
--  Name    - Specifies the name to use for the test
--
-- Called to turn a name into a Quark and then the Quark back into a string.
-- Print out the results so we can have a log of what happens.
------------------------------------------------------------------------------
        begin

            Quark1 := To_Quark (Name, False);  
            Put ("Named " & What & " ");  
            Putx ('"' & Name & '"');  
            Put (' ');  
            Set_Col (31);  
            Put (To_Id (Quark1));  
            Put (" => ");  
            Putx ('"' & To_String (Quark1) & '"');  
            New_Line;

        end Qts;

        procedure Qtl (List : X_String) is
------------------------------------------------------------------------------
--  List    - Specifies a name/Quarks-list to use
--
-- Called to turn a list of names into a list of Quarks.  We print out the
-- list and the resultant list so that we have a log of what happens.
------------------------------------------------------------------------------
        begin

            Put (What & "-List := ");  
            Putx ('"' & List & '"');  
            New_Line;  
            To_Ql (List, Quark_List);  
            Put ("Result =>");  
            New_Line;  
            for I in Quark_List'Range loop  
                if Quark_List (I) = None then  
                    exit;  
                end if;  
                Put ("    ");  
                Put (I);  
                Put (' ');  
                Putx ('"' & To_String (Quark_List (I)) & '"');  
                New_Line;  
            end loop;  
            New_Line;

        end Qtl;

        procedure Qtbl (List : X_String) is
------------------------------------------------------------------------------
--  List    - Specifies a name/Quark-list to use
--
-- Called to turn a list of names into a list of Quarks.  We print out the
-- list and the resultant list so that we have a log of what happens.
------------------------------------------------------------------------------
        begin

            Put (What & "-List := ");  
            Putx ('"' & List & '"');  
            New_Line;  
            To_Bql (List, Bind_List, Quark_List);  
            Put ("Result =>");  
            New_Line;  
            for I in Quark_List'Range loop  
                if Quark_List (I) = None then  
                    exit;  
                end if;  
                Put ("    ");  
                Put (I);  
                Put (' ');  
                Put (X_Rm_Binding'Image (Bind_List (I)));  
                Put (' ');  
                Putx ('"' & To_String (Quark_List (I)) & '"');  
                New_Line;  
            end loop;  
            New_Line;

        end Qtbl;

    begin

----Call X_Rm_Unique_Quark a few times and make sure that each one results
--  in a new value.

        Section ("Unique_" & What);  
        for I in 1 .. 5 loop  
            Quark1 := Unique;  
            Put ("Unique " & What & " ");  
            Put (To_Id (Quark1));  
            Put (" => ");  
            Putx ('"' & To_String (Quark1) & '"');  
            New_Line;  
        end loop;

----See if we can turn strings into Quark and back again.

        Section ("To/From_String");  
        Qts ("QOne");  
        Qts ("RTwo");  
        Qts ("SThree");  
        Qts ("TFour");  
        Qts ("UAnd-A-Long-String");  
        Qts ("VSomething_Else");  
        Qts ("Wsomething_else");

----See if we can turn those same strings into the same Quark all over again.

        Section ("To/From_Old_String");  
        Qts ("QOne");  
        Qts ("RTwo");  
        Qts ("SThree");  
        Qts ("TFour");  
        Qts ("UAnd-A-Long-String");  
        Qts ("VSomething_Else");  
        Qts ("Wsomething_else");

----See if we can successfully parse some Quark lists.

        Section ("Simple " & What & " lists");  
        Qtl ("QOne");  
        Qtl ("RTwo.");  
        Qtl ("SThree.TFour");  
        Qtl ("TFour.SThree.QOne.RTwo.VSomething_Else");  
        Qtl ("UA.UB.UC.UD.UE.UF.UG");

----Try those same lists a Binding-Quark lists

        Section ("Tight " & What & "/Binding lists");  
        Qtbl ("QOne");  
        Qtbl ("RTwo.");  
        Qtbl ("SThree.TFour");  
        Qtbl ("TFour.SThree.QOne.RTwo.VSomething_Else");  
        Qtbl ("UA.UB.UC.UD.UE.UF.UG");

----Try those same lists a Binding-Quark lists and add some different bindings

        Section ("Mixed " & What & "/Binding lists");  
        Qtbl ("QOne");  
        Qtbl ("*QOne");  
        Qtbl (".QOne");  
        Qtbl ("RTwo.");  
        Qtbl ("RTwo*");  
        Qtbl ("SThree.TFour");  
        Qtbl ("SThree*TFour");  
        Qtbl ("TFour.SThree.QOne.RTwo.VSomething_Else");  
        Qtbl ("*TFour.SThree*QOne.RTwo*VSomething_Else");  
        Qtbl ("UA*UB*UC*UD.UE.UF.UG");

    end Test_One_Type;

    procedure Class_Test is  
       new Test_One_Type  
              (What        => "Class",  
               Quark       => X_Rm_Class,  
               None        => None_X_Rm_Class,  
               Quark_Array => X_Rm_Class_Array,  
               To_Quark    => X_Rm_String_To_Class,  
               To_String   => X_Rm_Class_To_String,  
               To_Ql       => X_Rm_String_To_Class_List,  
               To_Bql      => X_Rm_String_To_Binding_Class_List,  
               Unique      => X_Rm_Unique_Class,  
               To_Id       => Class_Id);

    procedure Name_Test is  
       new Test_One_Type  
              (What        => "Name",  
               Quark       => X_Rm_Name,  
               None        => None_X_Rm_Name,  
               Quark_Array => X_Rm_Name_Array,  
               To_Quark    => X_Rm_String_To_Name,  
               To_String   => X_Rm_Name_To_String,  
               To_Ql       => X_Rm_String_To_Name_List,  
               To_Bql      => X_Rm_String_To_Binding_Name_List,  
               Unique      => X_Rm_Unique_Name,  
               To_Id       => Name_Id);

    procedure Representation_Test is  
       new Test_One_Type  
              (What        => "Representation",  
               Quark       => X_Rm_Representation,  
               None        => None_X_Rm_Representation,  
               Quark_Array => X_Rm_Representation_Array,  
               To_Quark    => X_Rm_String_To_Representation,  
               To_String   => X_Rm_Representation_To_String,  
               To_Ql       => X_Rm_String_To_Representation_List,  
               To_Bql      => X_Rm_String_To_Binding_Representation_List,  
               Unique      => X_Rm_Unique_Representation,  
               To_Id       => Representation_Id);

begin

----Set up for debugging.

    Xlbmp_Debugger.Register_Debugging_Imagers;

    -- Empty the quark map in case we're run after Rm_010.
    declare  
        Quark_Map : X_Rm_Quark_Map.Map;  
    begin  
        X_Lib.Seize_Quark_Map (Quark_Map);  
        X_Rm_Quark_Map.New_Map (Quark_Map);  
        X_Lib.Release_Quark_Map (Quark_Map);  
    end;

    X_Lib.Set_Next_Quark (Quark => (Id => 2000));
    -- Force testing to begin with a known state.
    -- Applications that do this are committing
    -- suicide.

----Perform tests.

    Class_Test;  
    Name_Test;  
    Representation_Test;

end Rm_020;