|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 10840 (0x2a58)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦49e7f20b9⟧
└─⟦this⟧
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;