|
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: 12040 (0x2f08)
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 Log;
with Lines;
with Syntax;
with Errors;
with Profile;
with Subtypes;
use Subtypes;
with Arguments;
with Pathnames;
with Structure;
with Object_Info;
with Consistency;
with Debug_Tools;
with Directory_Tools;
with Structure_Utilities;
procedure Check_Consistency (This_Structure : in String := "<SELECTION>";
This_Version : in Simple_Name := "<DEFAULT>";
Response : in String := "<PROFILE>") is
--
-- ***** MODIFY AT YOUR OWN RISK
--
Old_Response_Profile : Profile.Response_Profile := Profile.Get;
New_Response_Profile : Profile.Response_Profile := Profile.Value (Response);
--
package Error is
new Errors
(Old_Response_Profile, New_Response_Profile, "Check_Consistency");
--
function "=" (This_Section_Kind : in Syntax.Section_Kinds;
That_Section_Kind : in Syntax.Section_Kinds)
return Boolean renames Syntax."=";
function "=" (This_Item_Kind : in Syntax.Item_Kinds;
That_Item_Kind : in Syntax.Item_Kinds) return Boolean
renames Syntax."=";
--
Unfiltered_Catalog : Structure.Catalog;
--
The_Catalog : Structure.Catalog;
--
type Objectives is (Entire_Catalog, Section_Only, Item_Only);
--
type State is
record
Objective : Objectives := Entire_Catalog;
Catalog_Objective : Lines.Line := Lines.Empty_Line;
Section_Objective : Lines.Line := Lines.Empty_Line;
Item_Objective : Lines.Line := Lines.Empty_Line;
Objective_Located : Boolean := False;
Is_Consistent : Boolean := True;
Version : Lines.Line := Lines.Empty_Line;
end record;
--
Cannot_Resolve_Structure : exception;
Cannot_Resolve_Version : exception;
Invalid_Name : exception;
--
type Reports is (Warnings, Errors);
--
procedure Report (This_Message : in String;
The_State : in out State;
Message_Kind : in Reports := Errors) is
begin
case (Message_Kind) is
when Warnings =>
Log.Put_Line (This_Message, Profile.Warning_Msg);
when Errors =>
Log.Put_Line (This_Message, Profile.Error_Msg);
The_State.Is_Consistent := False;
end case;
end Report;
--
function Initial_State_For
(This_Structure : in String; This_Version : in String)
return State is
--
-- This function sets up the state so that traversal will be
-- controlled correctly.
--
The_State : State;
--
The_Structure : Directory_Tools.Object.Handle :=
Directory_Tools.Naming.Resolution (This_Structure);
--
The_Structure_Name : constant String :=
Directory_Tools.Naming.Full_Name (The_Structure);
--
begin
if (Directory_Tools.Object.Is_Bad (The_Structure)) then
raise Cannot_Resolve_Structure;
end if;
if (Pathnames.Is_Valid_Item_Name (The_Structure_Name)) then
The_State.Objective := Item_Only;
The_State.Catalog_Objective :=
Lines.Create (Pathnames.Catalog_Containing_Item
(The_Structure_Name));
The_State.Section_Objective :=
Lines.Create (Pathnames.Section_Containing_Item
(The_Structure_Name));
The_State.Item_Objective := Lines.Create (The_Structure_Name);
elsif (Pathnames.Is_Valid_Section_Name (The_Structure_Name)) then
The_State.Objective := Section_Only;
The_State.Catalog_Objective :=
Lines.Create (Pathnames.Catalog_Containing_Section
(The_Structure_Name));
The_State.Section_Objective := Lines.Create (The_Structure_Name);
elsif (Pathnames.Is_Valid_Catalog_Name (The_Structure_Name)) then
The_State.Objective := Entire_Catalog;
The_State.Catalog_Objective := Lines.Create (The_Structure_Name);
else
raise Invalid_Name;
end if;
declare
--
The_Version_Name : constant String :=
Arguments.Version_From
(Directory_Tools.Naming.Simple_Name
(Lines.Image (The_State.Catalog_Objective)),
This_Version);
--
The_Version : Directory_Tools.Object.Handle :=
Directory_Tools.Naming.Resolution (The_Version_Name);
--
begin
if (Directory_Tools.Object.Is_Bad (The_Version)) then
raise Cannot_Resolve_Version;
end if;
The_State.Version := Lines.Create (The_Version_Name);
end;
return (The_State);
end Initial_State_For;
--
function Objective_Name (This_State : in State) return Full_Name is
begin
case This_State.Objective is
when Entire_Catalog =>
return (Lines.Image (This_State.Catalog_Objective));
when Section_Only =>
return (Lines.Image (This_State.Section_Objective));
when Item_Only =>
return (Lines.Image (This_State.Item_Objective));
end case;
end Objective_Name;
--
function Version_For (This_State : in State) return Full_Name is
begin
return (Lines.Image (This_State.Version));
end Version_For;
--
procedure Report_Objective_Located (This_State : in out State) is
begin
This_State.Objective_Located := True;
end Report_Objective_Located;
--
function Located_Objective
(This_Catalog : in Structure.Catalog; This_State : in State)
return Boolean is
begin
return ((This_State.Objective = Entire_Catalog) and then
(Structure.Full_Location_Of (This_Catalog) =
Lines.Image (This_State.Catalog_Objective)));
end Located_Objective;
--
procedure Check_Catalog_Node
(This_Catalog : in Structure.Catalog;
This_State : in out State;
Control_Result : out Structure.Traversal_Control) is separate;
--
function Should_Be_Skipped
(This_Section : in Structure.Section; This_State : in State)
return Boolean is
begin
return (((This_State.Objective = Section_Only) and then
(Structure.Full_Location_Of (This_Section) /=
Lines.Image (This_State.Section_Objective))) or else
((This_State.Objective = Item_Only) and then
(Structure.Full_Location_Of (This_Section) /=
Lines.Image (This_State.Section_Objective))));
end Should_Be_Skipped;
--
function Located_Objective
(This_Section : in Structure.Section; This_State : in State)
return Boolean is
begin
return ((This_State.Objective = Section_Only) and then
(Structure.Full_Location_Of (This_Section) =
Lines.Image (This_State.Section_Objective)));
end Located_Objective;
--
procedure Check_Section_Node
(This_Section : in Structure.Section;
This_State : in out State;
Control_Result : out Structure.Traversal_Control) is separate;
--
function Should_Be_Skipped
(This_Item : in Structure.Item; This_State : in State)
return Boolean is
begin
return ((This_State.Objective = Item_Only) and then
(Structure.Full_Location_Of (This_Item) /=
Lines.Image (This_State.Item_Objective)));
end Should_Be_Skipped;
--
function Located_Objective
(This_Item : in Structure.Item; This_State : in State)
return Boolean is
begin
return ((This_State.Objective = Item_Only) and then
(Structure.Full_Location_Of (This_Item) =
Lines.Image (This_State.Item_Objective)));
end Located_Objective;
--
procedure Check_Item_Node
(This_Item : in Structure.Item;
This_State : in out State;
Control_Result : out Structure.Traversal_Control) is separate;
--
procedure Report_Results (This_Catalog : in Structure.Catalog;
This_State : in out State) is
begin
if (not This_State.Is_Consistent) then
Error.Report ("Specified structure """ &
Objective_Name (This_State) & """ is NOT consistent",
Nested => True);
end if;
if (not This_State.Objective_Located) then
Error.Report ("Could not locate specified object """ &
Objective_Name (This_State) & """ in data file",
Nested => True);
end if;
end Report_Results;
--
procedure Verify_Consistency is new Structure.Traverse (State,
Check_Catalog_Node,
Check_Section_Node,
Check_Item_Node,
Report_Results);
--
begin
Profile.Set (New_Response_Profile);
Log.Put_Line ("[Check_Consistency (This_Structure => """ &
This_Structure & """, This_Version => """ &
This_Version & """, Response => """ & Response & """)]",
Profile.Auxiliary_Msg);
--
declare
--
The_State : State := Initial_State_For (This_Structure, This_Version);
--
begin
Log.Put_Line ("Parsing data file");
Unfiltered_Catalog := Structure_Utilities.Catalog_For
(Version_For (The_State));
Structure.Assert_Is_Good (Unfiltered_Catalog);
Structure_Utilities.Display_Diagnostic
(Unfiltered_Catalog, Response, Display_Warning_Messages => True);
Log.Put_Line ("Data file parsed", Profile.Positive_Msg);
Log.Put_Line ("Filtering catalog");
The_Catalog := Structure_Utilities.Filtered_Catalog_From
(Unfiltered_Catalog);
Log.Put_Line ("Catalog filtered", Profile.Positive_Msg);
begin
Log.Put_Line ("Verifying filtered catalog");
Structure_Utilities.Verify (The_Catalog, Response => Response);
Log.Put_Line ("Filtered catalog verified", Profile.Positive_Msg);
--
exception
when others =>
Error.Report ("Unable to verify filtered catalog, quitting",
Nested => True);
--
end;
Log.Put_Line ("Checking consistency");
Verify_Consistency (The_Catalog, The_State);
end;
Log.Put_Line ("[end of Check_Consistency operation--no error(s) detected]");
Profile.Set (Old_Response_Profile);
--
exception
when Cannot_Resolve_Structure =>
Error.Report ("Cannot resolve """ & This_Structure & """");
when Cannot_Resolve_Version =>
Error.Report ("Cannot resolve """ & This_Version & """");
when Invalid_Name =>
Error.Report ("Specified structure """ & This_Structure &
""" is not an Item, Section, or Catalog");
when Structure.Bad_Element =>
Structure_Utilities.Display_Diagnostic
(Unfiltered_Catalog, Response, Display_Warning_Messages => True);
Error.Report (Error.Nil_Message);
when Error.Propagate =>
raise;
when Error.Quit =>
null;
when others =>
Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name,
Profile.Exception_Msg);
--
end Check_Consistency;