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

⟦6766d7566⟧ TextFile

    Length: 10840 (0x2a58)
    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 Rm_Test_Utilities;

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

with Xlbp_Rm;  
use Xlbp_Rm;

procedure Rm_060 is
------------------------------------------------------------------------------
-- Tests for Xlbp_Rm - Precedence order tests.
------------------------------------------------------------------------------
-- *****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- * 29-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 ("Section " & Section & " test 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;  
                   Expect  : X_String := "";  
                   Section : String) is
        -- Lookup an entry in the database.
        Rep : X_Rm_Representation;  
        Val : X_Rm_Value;  
    begin  
        Test_Io.Putx ("(""" & Names & """, """ & Classes & """) => ");  
        X_Rm_Get_Resource (Db, Names, Classes, Rep, Val);  
        Test_Io.Put_Line (Rm_Test_Utilities.Image (Val));

        if (Expect = "") then  
            Check (Val = None_X_Rm_Value, "Expected: no entry", Section);  
        else  
            Check (Val /= None_X_Rm_Value and then  
                   Val.Kind = Is_X_String_Pointer and then  
                   Val.V_X_String_Pointer.all = Expect,  
                   "Expected: """ & To_String (Expect) & '"', Section);  
        end if;  
    end Get;

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

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

    procedure Test_Rule_1 is  
        Section : constant String := "Rule_1";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " &  
                         "The attribute of the name and class must match.");

        Add (Db, "rule_1.foo: true", Section);  
        Get (Db, ".rule_1.bar", ".Rule_1.Bar", "", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Rule_1;

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

    procedure Test_Rule_2 is  
        Section : constant String := "Rule_2";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " &  
                         "Tight bindings override loose bindings.");

        Add (Db, "rule_2.-2-: tight", Section);  
        Add (Db, "rule_2*-2-: loose", Section);  
        Add (Db, "*-2-: very_loose", Section);  
        Get (Db, "rule_2.-2-", "Rule_2.-2-", "tight", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Rule_2;

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

    procedure Test_Rule_3 is  
        Section : constant String := "Rule_3";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " & "Names override classes.");

        Add (Db, "*rule_3.foo: name", Section);  
        Add (Db, "*Rule_3.Foo: class", Section);  
        Get (Db, "rule_3.foo", "Rule_3.Foo", "name", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Rule_3;

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

    procedure Test_Rule_4 is  
        Section : constant String := "Rule_4";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " &  
                         "Explicit attributes override implicit ones.");

        Add (Db, "rule_4*foo*bar: qualified", Section);  
        Add (Db, "rule_4*bar: unqualified", Section);  
        Get (Db, "rule_4.foo.bar", "Rule_4.Foo.Bar", "qualified", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Rule_4;

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

    procedure Test_Rule_5 is  
        Section : constant String := "Rule_5";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " &  
                         "Left components override right components.");

        Add (Db, "*foo*rule_5: foo", Section);  
        Add (Db, "*bar*rule_5: bar", Section);  
        Get (Db, ".foo.bar.rule_5", "Foo.Bar.Rule_5", "foo", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Rule_5;

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

    procedure Test_Rule_6 is  
        Section : constant String := "Rule_6";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " &  
                         "Tight binding is implicit for the first component.");

        Add (Db, "rule_6: foo", Section);  
        Add (Db, "*rule_6: bar", Section);  
        Get (Db, ".rule_6", ".Rule_6", "foo", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Rule_6;

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

    procedure Test_Mixed_Attributes is  
        Section : constant String := "Mixed_Attributes";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " & "Names and classes may be mixed.");

        Add (Db, "xmh*bg:          red", Section);  
        Add (Db, "*cmd.font:       8x13", Section);  
        Add (Db, "*cmd.bg:         blue", Section);  
        Add (Db, "*Cmd.Fg:         green", Section);  
        Add (Db, "xmh.toc*Cmd.aFg: black", Section);  
        Get (Db, ".xmh.toc.msgf.incl.aFg",  
             ".Xmh.VPaned.Box.Cmd.Fg", "black", Section);

        Free_X_Rm_Database (Db);  
        Test_Io.New_Line;  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Mixed_Attributes;

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

    procedure Test_Precedence is  
        Section : constant String := "Precedence";  
        Db      : X_Rm_Database   := None_X_Rm_Database;  
    begin  
        Test_Io.Section (Section & ": " &  
                         "The lowest numbered rule wins conflicts.");

        -- Rule 1 vs. everything.
        -- We'll take this for granted.

        -- Rule 2 vs. 3.
        Add (Db, ".a.B:         Rule 2 vs. 3", Section);  
        Add (Db, "*a.b:         Rule 3 vs. 2", Section);  
        Get (Db, ".a.b", ".A.B", "Rule 2 vs. 3", Section);  
        Test_Io.New_Line;

        -- Rule 2 vs. 4.
        Free_X_Rm_Database (Db);  
        Add (Db, ".a*c:         Rule 2 vs. 4", Section);  
        Add (Db, "*a.b.c:       Rule 4 vs. 2", Section);  
        Get (Db, ".a.b.c", ".A.B.C", "Rule 2 vs. 4", Section);  
        Test_Io.New_Line;

        -- Rule 2 vs. 5.
        Free_X_Rm_Database (Db);  
        Add (Db, ".a*c*d:       Rule 2 vs. 5", Section);  
        Add (Db, "*a*b*d:       Rule 5 vs. 2", Section);  
        Get (Db, ".a.b.c.d", ".A.B.C.D", "Rule 2 vs. 5", Section);  
        Test_Io.New_Line;

        -- Rule 2 vs. 6.
        -- How can this be tested?  Rule 6 is a really a parsing rule,
        -- not a precedence rule.

        -- Rule 3 vs. 4.
        Free_X_Rm_Database (Db);  
        Add (Db, "a*c:          Rule 3 vs. 4", Section);  
        Add (Db, "A.B.C:        Rule 4 vs. 3", Section);  
        Get (Db, ".a.b.c", ".A.B.C", "Rule 3 vs. 4", Section);  
        Test_Io.New_Line;

        -- Rule 3 vs. 5.
        Free_X_Rm_Database (Db);  
        Add (Db, "a*c*d:        Rule 3 vs. 5", Section);  
        Add (Db, "A*b*d:        Rule 5 vs. 3", Section);  
        Get (Db, ".a.b.c.d", ".A.B.C.D", "Rule 3 vs. 5", Section);  
        Test_Io.New_Line;

        -- Rule 3 vs. 6: see 2 vs. 3 above.

        -- Rule 4 vs. 5.
        Free_X_Rm_Database (Db);  
        Add (Db, "a*c*d:        Rule 4 vs. 5", Section);  
        Add (Db, "*b*d:         Rule 5 vs. 4", Section);  
        Get (Db, ".a.b.c.d", ".A.B.C.D", "Rule 4 vs. 5", Section);  
        Test_Io.New_Line;

        -- Rule 4 vs. 6: see 2 vs. 4 above.

        -- Rule 5 vs. 6: see 2 vs. 5 above.

        Free_X_Rm_Database (Db);  
    exception  
        when others =>  
            Check (False, "Unhandled exception", Section);  
            raise;  
    end Test_Precedence;

begin
    -- Simple rule tests
    Test_Rule_1;  
    Test_Rule_2;  
    Test_Rule_3;  
    Test_Rule_4;  
    Test_Rule_5;  
    Test_Rule_6;

    -- Slightly more complex tests
    Test_Mixed_Attributes;  
    Test_Precedence;

end Rm_060;