|
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: 9499 (0x251b)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦49e7f20b9⟧
└─⟦this⟧
with Test_Io;
use Test_Io;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Rm;
use Xlbt_Rm;
with Xlbt_Rm2;
use Xlbt_Rm2;
with Xlbt_String;
use Xlbt_String;
with Xlbp_Rm_Quark;
use Xlbp_Rm_Quark;
with Xlbit_Library3;
use Xlbit_Library3;
with Xlbmp_Debugger;
procedure Rm_010 is
------------------------------------------------------------------------------
-- Tests for Xlbp_Rm_Quark.
------------------------------------------------------------------------------
-- 07/05/90 GEB | Created.
------------------------------------------------------------------------------
Quark1 : X_Rm_Quark;
Quark2 : X_Rm_Quark;
type Quark_Array is array (S_Natural range <>) of X_Rm_Quark;
Quark_List : Quark_Array (1 .. 10);
Bind_List : X_Rm_Binding_Array (1 .. 10);
Validate_Names : Boolean := True;
function X_Rm_Str_To_Q
(Name : X_String;
Validate : Boolean := Validate_Names) return X_Rm_Quark;
procedure X_Rm_Str_To_Ql is
new X_Rm_String_To_Quark_List
(Quark_Type => X_Rm_Quark,
None_Quark => None_X_Rm_Quark,
Quark_Array_Type => Quark_Array,
String_To_Quark => X_Rm_Str_To_Q);
procedure X_Rm_Str_To_Bl is
new X_Rm_String_To_Binding_Quark_List
(Quark_Type => X_Rm_Quark,
None_Quark => None_X_Rm_Quark,
Quark_Array_Type => Quark_Array,
String_To_Quark => X_Rm_Str_To_Q);
function X_Rm_Str_To_Q
(Name : X_String;
Validate : Boolean := Validate_Names) return X_Rm_Quark is
begin
return X_Rm_String_To_Quark (Name, Validate);
end X_Rm_Str_To_Q;
procedure Qts (Name : X_String; Valid : Boolean := True) is
------------------------------------------------------------------------------
-- Name - Specifies the name to use for the test
-- Valid - Specifies if the name is a valid component name.
--
-- 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
if Validate_Names then
Put ("Component ");
else
Put ("Quark ");
end if;
Putx ('"' & Name & '"');
Put (' ');
Set_Col (31);
Quark1 := X_Rm_Str_To_Q (Name);
Put (Quark1.Id);
Put (" => ");
Putx ('"' & X_Rm_Quark_To_String (Quark1) & '"');
if Validate_Names and not Valid then
Put ('?');
end if;
New_Line;
exception
when Constraint_Error =>
if not Valid then
Put_Line (" is invalid.");
else
raise;
end if;
end Qts;
procedure Qtl (List : X_String; Valid : Boolean := True) is
------------------------------------------------------------------------------
-- List - Specifies a name/quark-list to use
-- Valid - Specifies if the list is a valid component name list.
--
-- 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
if Validate_Names then
Put ("Components := ");
else
Put ("Quark-List := ");
end if;
Putx ('"' & List & '"');
New_Line;
Put ("Result => ");
X_Rm_Str_To_Ql (List, Quark_List);
if Validate_Names and not Valid then
Put ('?');
end if;
New_Line;
for I in Quark_List'Range loop
if Quark_List (I) = None_X_Rm_Quark then
exit;
end if;
Put (" ");
Put (I);
Put (' ');
Putx ('"' & X_Rm_Quark_To_String (Quark_List (I)) & '"');
New_Line;
end loop;
New_Line;
exception
when Constraint_Error =>
if Validate_Names and not Valid then
Put (" invalid");
New_Line;
else
raise;
end if;
end Qtl;
procedure Qtbl (List : X_String; Valid : Boolean := True) is
------------------------------------------------------------------------------
-- List - Specifies a name/quark-list to use
-- Valid - Specifies if the list is a valid component name list.
--
-- 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
if Validate_Names then
Put ("Components := ");
else
Put ("Quark-List := ");
end if;
Putx ('"' & List & '"');
New_Line;
Put ("Result => ");
X_Rm_Str_To_Bl (List, Bind_List, Quark_List);
if Validate_Names and not Valid then
Put ('?');
end if;
New_Line;
for I in Quark_List'Range loop
if Quark_List (I) = None_X_Rm_Quark then
exit;
end if;
Put (" ");
Put (I);
Put (' ');
Put (X_Rm_Binding'Image (Bind_List (I)));
Put (' ');
Putx ('"' & X_Rm_Quark_To_String (Quark_List (I)) & '"');
New_Line;
end loop;
New_Line;
exception
when Constraint_Error =>
if Validate_Names and not Valid then
Put ("invalid");
New_Line;
else
raise;
end if;
end Qtbl;
begin
----Set up for debugging.
Xlbmp_Debugger.Register_Debugging_Imagers;
X_Lib.Set_Next_Quark (Quark => (Id => 1000));
-- Force testing to begin with a known state.
-- Applications that do this are committing
-- suicide.
----Call X_Rm_Unique_Quark a few times and make sure that each one results
-- in a new value.
Section ("X_Rm_Unique_Quark");
for I in 1 .. 5 loop
Quark1 := X_Rm_Unique_Quark;
Put ("Unique quark ");
Put (Quark1.Id);
Put (" => ");
Putx (X_Rm_Quark_To_String (Quark1));
New_Line;
end loop;
----See if we can turn strings into quarks and back again.
Section ("X_Rm_Quark_To/From_String");
Qts ("0");
Qts ("One");
Qts ("Two");
Qts ("Three");
Qts ("Four");
Qts ("And-A_Long_String");
Qts ("Something_Else");
Qts ("something_else");
----See if we can turn those same strings into the same quarks all over again.
Section ("X_Rm_Quark_To/From_Old_String");
Qts ("0");
Qts ("One");
Qts ("Two");
Qts ("Three");
Qts ("Four");
Qts ("And-A_Long_String");
Qts ("Something_Else");
Qts ("something_else");
----See if we can successfully parse some quark lists.
Section ("Simple quark lists");
Qtl ("One");
Qtl ("Two.");
Qtl ("Three*Four");
Qtl ("Four.Three.One.Two.Something_Else");
Qtl ("_0*1.2-3_");
Qtl ("A.B.C.D.E.F.G");
----Try those same lists a Binding-Quark lists
Section ("Tight Quark/Binding lists");
Qtbl ("One");
Qtbl ("Two.");
Qtbl ("Three.Four");
Qtbl ("Four.Three.One.Two.Something_Else");
Qtbl ("A.B.C.D.E.F.G");
----Try those same lists a Binding-Quark lists and add some different bindings
Section ("Mixed Quark/Binding lists");
Qtbl ("One");
Qtbl ("*One");
Qtbl (".One");
Qtbl ("Two.");
Qtbl ("Two*");
Qtbl ("Three.Four");
Qtbl ("Three*Four");
Qtbl ("Four.Three.One.Two.Something_Else");
Qtbl ("*Four.Three*One.Two*Something_Else");
Qtbl ("A*B*C*D.E.F.G");
----Try some interesting QTS cases.
Section ("Interesting X_Rm_Quark_To/From_String cases");
Qts ("");
Qts ("");
Qts (".", False);
Qts ("*", False);
Qts ("A bad component..", False);
Validate_Names := False;
Qts ("...but a good quark!", False);
Qts ("...but a good quark!", False);
Validate_Names := True;
----And some interesting QTL cases.
Section ("Interesting X_Rm_Quark_To_List cases");
Qtl ("Mixed*Separators.In.Component*Lists");
Qtl ("... Bogus list ...", False);
Qtl ("...Valid.List...");
Qtl ("Nul.Terminator" & Nul & " stops processing");
Qtl (Nul & " Leading null");
Qtl ("Another.Nul." & Nul);
Validate_Names := False;
Qtl ("Junk accepted in *QUARK* lists!", False);
Validate_Names := True;
Qtl ("");
Qtl ("*.*.*");
----And some interesting QTBL cases.
Section ("Interesting X_Rm_Quark_To_Binding_List cases");
Qtbl ("");
Qtbl (".*.*.");
Qtbl ("... Bogus list ...", False);
Qtbl ("...Valid.list...");
Qtbl ("*Terminating.Nul" & Nul & " stops processing");
Qtbl (Nul & " Leading nul");
Qtbl ("Another.Nul." & Nul);
Validate_Names := False;
Qtbl ("Junk accepted in *QUARK* lists!", False);
Validate_Names := True;
end Rm_010;