DataMuseum.dk

top - download

    Length: 6428 (0x191c)
    Types: TextFile
    Names: »B«

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

TextFile

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_080 is
------------------------------------------------------------------------------
-- Tests for Xlbp_Rm - Bulk database loading
------------------------------------------------------------------------------
-- *****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- * 31-OCT-90 - /DRK/ Created.
-- * 19-NOV-90 - /GEB/ New RM error returns.
-- *****************************************************************************

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

    procedure Check (Condition : Boolean; Message : String; Section : 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 section " & Section & " failed.");  
        end if;  
    end Check;

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

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

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

    procedure Add (Db      : in out X_Rm_Database;  
                   Line    :        X_String;  
                   Section :        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, Section);  
    end Add;

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

    procedure Get (Db      : X_Rm_Database;  
                   Names   : X_String;  
                   Classes : X_String;  
                   Section : String) is
        -- Lookup an entry in the database.
        Db_Type  : X_Rm_Representation;  
        Db_Value : X_Rm_Value;  
    begin  
        Test_Io.Putx ("(""" & Names & """, """ & Classes & """) => ");  
        X_Rm_Get_Resource (Db, Names, Classes, Db_Type, Db_Value);  
        Test_Io.Put (Rm_Test_Utilities.Image (Db_Value));  
    end Get;

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

    function Check_File_Db (Db      : X_Rm_Database;  
                            Section : String) return X_Rm_Database is
        -- Test writing/reading databases from files.
        -- Returns an "identical" copy of the DB provided.

        Tmp_1 : constant String :=  
           Test_Io.Append_File_Extension ("RM_080_1", "TMP");  
        Tmp_2 : constant String :=  
           Test_Io.Append_File_Extension ("RM_080_2", "TMP");  
        Db_2  : X_Rm_Database;  
        Error : X_Rm_Status;  
    begin
        -- Dump our database.
        Test_Io.Put ("Write db_1 ... ");  
        X_Rm_Put_File_Database (Tmp_1, Db, Error);  
        Check (Error, Section);

        -- Load into a new database.
        Test_Io.Put ("read db_2 ... ");  
        X_Rm_Get_File_Database (Tmp_1, Db_2, Error);  
        Check (Error, Section);

        -- Dump the new database.
        Test_Io.Put ("write db_2 ... ");  
        X_Rm_Put_File_Database (Tmp_2, Db_2, Error);  
        Check (Error, Section);

        -- Compare the two dumps.
        Test_Io.Put ("compare dumps ... ");  
        if not Test_Io.Files_Equal (Tmp_1, Tmp_2, False, False) then  
            Check (False, "Database dumps differ.", Section);  
            Test_Io.Files_Diff (Tmp_1, Tmp_2, False, False);  
        end if;

        -- Cleanup.
        Test_Io.Put_Line ("done.");  
        Test_Io.File_Delete (Tmp_1);  
        Test_Io.File_Delete (Tmp_2);

        -- Return the copied database.
        return Db_2;  
    end Check_File_Db;

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

    function Get_String_Db (Data    : X_String;  
                            Section : String) return X_Rm_Database is
        -- Construct a database from a string.
        Error : X_Rm_Status;  
        Db_1  : X_Rm_Database := None_X_Rm_Database;  
        Db_2  : X_Rm_Database := None_X_Rm_Database;  
    begin
        -- Convert the string to a database.
        Test_Io.Put_Line ("Create database from string:");  
        Test_Io.Putx_Line ('"' & Data & '"');  
        X_Rm_Get_String_Database (Data, Db_1, Error);  
        Check (Error, Section);

        -- Send the database to a file.
        Db_2 := Check_File_Db (Db_1, Section);

        -- Clean up.
        Free_X_Rm_Database (Db_1);  
        return Db_2;  
    end Get_String_Db;

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

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

    procedure Test_String_Db (Data : X_String; Section : String) is  
        Db : X_Rm_Database;  
    begin  
        Test_Io.Section ("String database " & Section);

        -- Build the database.
        Db := Get_String_Db (Data, Section);

        -- Probe for some standard values.
        Get (Db, "", "", Section);  
        Get (Db, "a", "A", Section);  
        Get (Db, "a.b", "A.B", Section);  
        Get (Db, "a.b.c", "A.B.C", Section);  
        Get (Db, "a.b.c.d", "A.B.C.D", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    end Test_String_Db;

begin
    -- Tests with only string valued resources.
    Test_String_Db ("", "Null_DB");  
    Test_String_Db ("! An empty database", "Empty_DB");  
    Test_String_Db ("*a: *a", "Simple_DB");  
    Test_String_Db ("! A short database" & Lf &  
                    "" & Lf &  
                    ".a: .a" & Lf &  
                    "*b: *b" & Lf, "Short_DB");  
    Test_String_Db ("! A multi-level database" & Lf &  
                    "              " & Lf &  
                    "a.b:       a.b" & Lf &  
                    "!\000: Ignored" & Lf &  
                    "*c:        *\143" & Lf &  
                    "*d:        \" & Lf &  
                    "           *d", "Multi-Level_DB");  
end Rm_080;