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 := ""; This_Version : in Simple_Name := ""; Response : in String := "") 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;