⟦74362d457⟧

E3 Source Code



with Test_Io;  
with Rm_Test_Utilities;

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

with Xlbp_Rm;  
use Xlbp_Rm;  
with Xlbp_Rm_Name;  
use Xlbp_Rm_Name;

procedure Rm_070 is
------------------------------------------------------------------------------
-- Tests for Xlbp_Rm - Database Search Lists
------------------------------------------------------------------------------
-- *****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- * 30-OCT-90 - /DRK/ Created.
-- * 19-NOV-90 - /GEB/ New RM error returns.
-- *****************************************************************************

    ---------------------
    -- Local variables --
    ---------------------

    Db : X_Rm_Database := None_X_Rm_Database;

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

    ---------------
    -- Utilities --
    ---------------

    procedure Check (Condition : Boolean; Message : String) is
        -- Check a condition.  If it doesn't hold, print error messages.
    begin  
        if not Condition then  
            Test_Io.Put_Line (Message);  
            Test_Io.Put_Error ("Test failed.");  
        end if;  
    end Check;

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

    procedure Check (Error : X_Rm_Status) is
        -- Check that no errors were reported.
    begin  
        Check (Error = Rm_Successful, "RM error");  
    end Check;

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

    procedure Add (Db : in out X_Rm_Database; Line : X_String) is
        -- Add an entry to a database.
        Error : X_Rm_Status;  
    begin  
        Test_Io.Put_Line ("Adding """ & To_String (Line) & '"');  
        X_Rm_Add_Resource (Db, Line, Error);  
        Check (Error);  
    end Add;

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

    function Name_List (Names : X_String) return X_Rm_Name_Array is  
        Result : X_Rm_Name_Array (1 .. Names'Length + 2);  
    begin  
        X_Rm_String_To_Name_List (Names, Result);  
        return Result;  
    end Name_List;

    function Class_List (Classes : X_String) return X_Rm_Class_Array is  
        Result : X_Rm_Class_Array (1 .. Classes'Length + 2);  
    begin  
        X_Rm_String_To_Class_List (Classes, Result);  
        return Result;  
    end Class_List;

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

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

    procedure Create_Database (Db : in out X_Rm_Database) is  
    begin  
        Test_Io.Section ("Creating a sample database");  
        Add (Db, "*Anything:        *Anything");  
        Add (Db, "*anything:        *anything");  
        Add (Db, "A.Detailed.Class: A.Detailed.Class");  
        Add (Db, "a.detailed.name:  a.detailed.name");  
        Add (Db, "*A*Class:         *A*Class");  
        Add (Db, "*a*name:          *a*name");  
        Add (Db, ".a*Class:         .a*Class");  
        Test_Io.New_Line;  
    end Create_Database;

    procedure Lookup_Entries (Db      : X_Rm_Database;  
                              Names   : X_String;  
                              Classes : X_String) is  
        List : constant X_Rm_Search_List :=  
           X_Rm_Get_Search_List (Db, Name_List (Names), Class_List (Classes));

        procedure Get (Name : X_String; Class : X_String) is  
            Search_Rep : X_Rm_Representation;  
            Search_Val : X_Rm_Value;  
            Probe_Rep  : X_Rm_Representation;  
            Probe_Val  : X_Rm_Value;  
        begin  
            Test_Io.Putx ("(""" & Name & """, """ & Class & """) => ");

            X_Rm_Get_Search_Resource  
               (List, X_Rm_String_To_Name (Name),  
                X_Rm_String_To_Class (Class), Search_Rep, Search_Val);  
            Test_Io.Put_Line (Rm_Test_Utilities.Image (Search_Val));  
            X_Rm_Get_Resource (Db, Names & '.' & Name,  
                               Classes & '.' & Class, Probe_Rep, Probe_Val);  
            Check (Search_Val = Probe_Val and then Search_Rep = Probe_Rep,  
                   "Expected: " & Rm_Test_Utilities.Image (Probe_Val));  
        end Get;  
    begin  
        Test_Io.Section (To_String ("Path (""" & Names &  
                                    """, """ & Classes & """)"));

        Get ("name", "Junk");  
        Get ("junk", "Class");  
        Get ("name", "Class");  
        Get ("something", "Anything");  
        Get ("junk", "Junk");

        Test_Io.New_Line;  
    end Lookup_Entries;

begin  
    Create_Database (Db);

    -- Run the tests.
    Lookup_Entries (Db, "", "");  
    Lookup_Entries (Db, "u.v.w", "x.A.z");  
    Lookup_Entries (Db, "u.a.w", "x.y.z");  
    Lookup_Entries (Db, "a", "A");  
    Lookup_Entries (Db, "a.a", "A.A");  
    Lookup_Entries (Db, "a.detailed", "A.Detailed");

    -- Try a few probes on an empty database.
    Lookup_Entries (None_X_Rm_Database, "empty_db", "Empty_DB");

    Free_X_Rm_Database (Db);  
end Rm_070;
DataMuseum.dk

Rational R1000/400

⟦74362d457⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
