|
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 - metrics - downloadIndex: B T
Length: 13110 (0x3336)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Text_Io, Singly_Linked_List;
use Text_Io;
package body Database_Interface is
-- Declarations for the database file
Test_Name_Xref_File_Name : constant String := "NAMEX.DAT";
Test_Name_Xref : File_Type;
-- Declarations for the contents of the database
Blank_Description : constant Description_Type := (others => ' ');
type Test_Information is
record
Name : Name_Type;
Architecture_Category : Architecture_Category_Type := Every;
Version : Version_Type := Other;
Statistics : Statistics_Type := Both;
Description : Description_Type := Blank_Description;
E_And_V_Criteria : E_And_V_Criteria_List; -- null list
Language_Features : Language_Features_List; -- null list
end record;
-- This list will hold the contents of the database
package Data_List is new Singly_Linked_List (Test_Information);
use Data_List;
type Data_List_Type is new Data_List.List_Type;
Database_Info : Data_List_Type;
---------------------------------------------------------------------------
-- Internal (Hidden) functions
package Abbrev_Io is new Enumeration_Io
(Schema.Language_Feature_Abbreviation_Type);
package E_And_V_Io is new Enumeration_Io
(Schema.E_And_V_Criterion_Abbreviation_Type);
use Abbrev_Io, E_And_V_Io;
--------------------------------------------------------------------
-- these functions manipulate lists for the cases where input extends
-- over more than one line
--------------------------------------------------------------------
function E_Copy (List : E_And_V_Criteria_List)
return E_And_V_Criteria_List is separate;
function Copy (List : Language_Features_List)
return Language_Features_List is separate;
function E_Concat (L1, L2 : E_And_V_Criteria_List)
return E_And_V_Criteria_List is separate;
function Concat (L1, L2 : Language_Features_List)
return Language_Features_List is separate;
--
-- this function gets the next database record from the database file
function Get_Record (File : File_Type) return Test_Information is separate;
-- this procedure searches the database, given the NAME as a key
-- It finds the first entry after the "current pointer" in the list.
-- Elements of the list must have a .NAME component
procedure Find_Record (Key : Name_Type;
List : in out Data_List_Type;
Data : out Test_Information) is
begin
-- assumes "current pointer" of LIST is set (need not be 1st)
loop
exit when Current_Element (List).Name = Key;
Next (List);
end loop;
Data := Current_Element (List);
Next (List);
exception
when Data_List.End_Error =>
raise Not_Found;
end Find_Record;
---------------------------------------------------------------------------
-- these functions search the database, given other keys
-- ** Could be Generic on Key type, with generic in parameter for
-- ** record component to match.
procedure Find_Record (Key : Architecture_Category_Type;
List : in out Data_List_Type;
Data : out Test_Information) is
begin
-- assumes "current pointer" of LIST is set (need not be 1st)
if Key /= Every then
loop
exit when Current_Element (List).Architecture_Category = Key;
Next (List);
end loop;
end if;
Data := Current_Element (List);
Next (List);
exception
when Data_List.End_Error =>
raise Not_Found;
end Find_Record;
--
procedure Find_Record (Key : E_And_V_Criterion_Abbreviation_Type;
List : in out Data_List_Type;
Data : out Test_Information) is
Found : Boolean;
Temp : E_And_V_Criteria_List;
procedure Member (Sub_List : in out E_And_V_Criteria_List;
Key : E_And_V_Criterion_Abbreviation_Type;
Flag : out Boolean) is
begin
Flag := False;
First (Sub_List);
loop
if Current_Element (Sub_List) = Key then
Flag := True;
exit;
end if;
exit when Tail_Node (Sub_List);
Next (Sub_List);
end loop;
exception
when Criterion_Lists.End_Error =>
Flag := False;
end Member;
begin
loop
Temp := Current_Element (List).E_And_V_Criteria;
Member (Temp, Key, Found);
exit when Found;
Next (List);
end loop;
Data := Current_Element (List);
Next (List);
exception
when Data_List.End_Error =>
raise Not_Found;
when Criterion_Lists.End_Error =>
Data := Current_Element (List);
end Find_Record;
--
procedure Find_Record (Key : Language_Feature_Abbreviation_Type;
List : in out Data_List_Type;
Data : out Test_Information) is
Found : Boolean;
Temp : Language_Features_List;
procedure Member (Sub_List : in out Language_Features_List;
Key : Language_Feature_Abbreviation_Type;
Flag : out Boolean) is
begin
Flag := False;
First (Sub_List);
loop
if Current_Element (Sub_List) = Key then
Flag := True;
exit;
end if;
exit when Tail_Node (Sub_List);
Next (Sub_List);
end loop;
exception
when Feature_Lists.End_Error =>
Flag := False;
end Member;
begin
loop
Temp := Current_Element (List).Language_Features;
Member (Temp, Key, Found);
exit when Found;
Next (List);
end loop;
Data := Current_Element (List);
Next (List);
exception
when Data_List.End_Error =>
raise Not_Found;
when Feature_Lists.End_Error =>
Data := Current_Element (List);
end Find_Record;
--
procedure Find_Record (Key : Statistics_Type;
List : in out Data_List_Type;
Data : out Test_Information) is
begin
if Key /= Both then
loop
exit when Current_Element (List).Statistics = Key;
Next (List);
end loop;
end if;
Data := Current_Element (List);
Next (List);
exception
when Data_List.End_Error =>
raise Not_Found;
end Find_Record;
--
procedure Find_Record (Key : Version_Type;
List : in out Data_List_Type;
Data : out Test_Information) is
begin
if Key /= All_Versions then
loop
exit when Current_Element (List).Version = Key;
Next (List);
end loop;
end if;
Data := Current_Element (List);
Next (List);
exception
when Data_List.End_Error =>
raise Not_Found;
end Find_Record;
---------------------------------------------------------------------------
-- Exported (visible) functions
--
-- These functions support query-by-name
--
function Get_Description (Input_Name : Name_Type) return Description_Type is
Temp : Test_Information;
begin
First (Database_Info); -- start at head of database
Find_Record (Input_Name, Database_Info, Temp);
return Temp.Description;
end Get_Description;
--
function Get_Arch_Category (Input_Name : Name_Type)
return Architecture_Category_Type is
Temp : Test_Information;
begin
First (Database_Info); -- start at head of database
Find_Record (Input_Name, Database_Info, Temp);
return Temp.Architecture_Category;
end Get_Arch_Category;
--
function Get_E_And_V_Categories
(Input_Name : Name_Type) return E_And_V_Criteria_List is
Temp : Test_Information;
begin
First (Database_Info); -- start at head of database
Find_Record (Input_Name, Database_Info, Temp);
return Temp.E_And_V_Criteria;
end Get_E_And_V_Categories;
--
function Get_Features (Input_Name : Name_Type)
return Language_Features_List is
Temp : Test_Information;
begin
First (Database_Info); -- start at head of database
Find_Record (Input_Name, Database_Info, Temp);
return Temp.Language_Features;
end Get_Features;
--
function Get_Statistics (Input_Name : Name_Type) return Statistics_Type is
Temp : Test_Information;
begin
First (Database_Info); -- start at head of database
Find_Record (Input_Name, Database_Info, Temp);
return Temp.Statistics;
end Get_Statistics;
--
function Get_Version (Input_Name : Name_Type) return Version_Type is
Temp : Test_Information;
begin
First (Database_Info); -- start at head of database
Find_Record (Input_Name, Database_Info, Temp);
return Temp.Version;
end Get_Version;
-----------------------------------------------------------------------------
-- These functions support query-by-attribute
--
function Names (Attribute : Architecture_Category_Type) return Name_List is
List : Name_List;
Temp : Test_Information;
begin
First (List);
First (Database_Info); -- start at head of database
loop
-- until search fails
Find_Record (Attribute, Database_Info, Temp);
Insert_After (List, Temp.Name);
end loop;
return List;
exception
when Not_Found =>
return List;
end Names;
--
function Names (Attribute : E_And_V_Criterion_Abbreviation_Type)
return Name_List is
List : Name_List;
Temp : Test_Information;
begin
First (List);
First (Database_Info); -- start at head of database
loop
-- until search fails
Find_Record (Attribute, Database_Info, Temp);
Insert_After (List, Temp.Name);
end loop;
return List;
exception
when Not_Found =>
return List;
end Names;
--
function Names (Attribute : Language_Feature_Abbreviation_Type)
return Name_List is
List : Name_List;
Temp : Test_Information;
begin
First (List);
First (Database_Info); -- start at head of database
loop
-- until search fails
Find_Record (Attribute, Database_Info, Temp);
Insert_After (List, Temp.Name);
end loop;
return List;
exception
when Not_Found =>
return List;
end Names;
--
function Names (Attribute : Statistics_Type) return Name_List is
List : Name_List;
Temp : Test_Information;
begin
First (List);
First (Database_Info); -- start at head of database
loop
-- until search fails
Find_Record (Attribute, Database_Info, Temp);
Insert_After (List, Temp.Name);
end loop;
return List;
exception
when Not_Found =>
return List;
end Names;
--
function Names (Attribute : Version_Type) return Name_List is
List : Name_List;
Temp : Test_Information;
begin
First (List);
First (Database_Info); -- start at head of database
loop
-- until search fails
Find_Record (Attribute, Database_Info, Temp);
Insert_After (List, Temp.Name);
end loop;
return List;
exception
when Not_Found =>
return List;
end Names;
---------------------------------------------------------------------------
begin
-- package body
-- Read the database file just once (it is never altered),
-- and store it in a list
Open (Test_Name_Xref, In_File, Test_Name_Xref_File_Name);
while not End_Of_File (Test_Name_Xref) loop
Insert_After (Database_Info, Get_Record (Test_Name_Xref));
end loop;
Close (Test_Name_Xref);
exception
when Name_Error =>
Put ("*** Error: ");
Put (Test_Name_Xref_File_Name);
Put_Line (" not found.");
when Text_Io.End_Error =>
Close (Test_Name_Xref);
end Database_Interface;
--*************************************************************************