|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Rm_080, seg_00562d
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
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 (Tp_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;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=23 rec1=00 rec2=01 rec3=042
[0x01] rec0=1a rec1=00 rec2=02 rec3=042
[0x02] rec0=1a rec1=00 rec2=03 rec3=014
[0x03] rec0=00 rec1=00 rec2=0a rec3=002
[0x04] rec0=19 rec1=00 rec2=04 rec3=042
[0x05] rec0=00 rec1=00 rec2=09 rec3=002
[0x06] rec0=1c rec1=00 rec2=05 rec3=022
[0x07] rec0=00 rec1=00 rec2=08 rec3=004
[0x08] rec0=22 rec1=00 rec2=06 rec3=002
[0x09] rec0=0f rec1=00 rec2=07 rec3=000
tail 0x21500a37e81978d3e27c2 0x42a00088462063203