DataMuseum.dk

top - metrics - download

    Length: 7010 (0x1b62)
    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⟧ 

TextFile

with Io;
with Log;
with Diana;
with Ada_Text;
with Directory_Tools;
with System_Utilities;
with Time_Utilities;
package body Report is
    package Object renames Directory_Tools.Object;
    package Naming renames Directory_Tools.Naming;
    package Low_Level renames Directory_Tools.Object.Low_Level;

    Indent : constant String := "  ";

    Separator : constant String :=
       Indent &
          "---------------------------------------------------------------------";

    Report_File : Io.File_Type;

    Temp_Output : constant String := "!machine.temporary.temp_unit_gen_output";

    procedure Create (Name : String) is
    begin
        Io.Create (Report_File, Io.Out_File, Name);
    end Create;

    procedure Close is
    begin
        Io.Close (Report_File);
    end Close;

    procedure User_Name_And_Time is
    begin
        Io.Put_Line (Report_File, Indent & "USER: " &
                                     System_Utilities.User_Name);
        Io.Put_Line (Report_File, Indent & "SESSION: " &
                                     System_Utilities.Session_Name);
        Io.Put_Line (Report_File,
                     Indent & "AT: " & Time_Utilities.Image
                                          (Time_Utilities.Get_Time));
    end User_Name_And_Time;

    procedure Value (Parameter_Name : String;
                     Value : Boolean;
                     Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name &
                                ": " & Boolean'Image (Value));
        Io.New_Line (Report_File);
    end Value;

    procedure Value (Parameter_Name : String;
                     Value : Character;
                     Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name & ": ");
        Io.Put (Report_File, "'" & Value & "'");
        Io.New_Line (Report_File);
    end Value;

    procedure Value (Parameter_Name : String;
                     Value : String;
                     Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name & ": ");
        Io.Put (Report_File, """" & Value & """");
        Io.New_Line (Report_File);

    end Value;

    procedure Value (Parameter_Name : String;
                     Value : Integer;
                     Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name & ": ");
        Io.Put (Report_File, Value);
        Io.New_Line (Report_File);

    end Value;

    procedure Value (Parameter_Name : String;
                     Value : Float;
                     Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name & ": ");
        Io.Put (Report_File, Value);
        Io.New_Line (Report_File);

    end Value;

    procedure User_Defined_Type (Parameter_Name : String;
                                 Value : User_Defined;
                                 Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name & ": ");
        Io.Put (Report_File, Image (Value));
        Io.New_Line (Report_File);

    end User_Defined_Type;

    procedure Put_Image (Obj : Object.Handle) is
        Decl : Diana.Tree;
        Stat : Object.Di.Error_Status;
        Error : Object.Error_Code;
        Image_Handle : Ada_Text.Handle;
        Image : Ada_Text.Area;
        Image_Iterator : Ada_Text.Iterator;
    begin
        Ada_Text.Open (Obj, Image_Handle, Error);
        Low_Level.Get_Declaration
           (Handle => Obj, The_Decl => Decl, Status => Stat);

        Decl := Diana.As_Parent (Decl);
        Image := Ada_Text.Where_Is (Decl, Image_Handle);

        Io.Put_Line (Report_File, Indent & "SUBPROGRAM PROFILE:");
        Io.New_Line (Report_File);
        Ada_Text.Initialize (Image_Handle, Image, Image_Iterator);

        while not Ada_Text.Done (Image_Iterator) loop
            Io.Put_Line (Report_File, Ada_Text.Value (Image_Iterator));
            Ada_Text.Next (Image_Iterator);
        end loop;

        Ada_Text.Close (Image_Handle, Error);
    end Put_Image;

    procedure Begin_Execution (Subprogram : String) is
        Obj : Object.Handle := Naming.Resolution
                                  (Subprogram, Object_Only => False);
    begin
        Io.Put_Line (Report_File, Separator);
        Io.New_Line (Report_File);
        Io.Put_Line (Report_File, Indent & "EXECUTING:");
        Io.New_Line (Report_File);

        Io.Put (Report_File, Indent & Indent & Subprogram);

        Io.New_Line (Report_File, 2);

        Put_Image (Obj);

    end Begin_Execution;

    procedure Capture_Output is
    begin
        Log.Set_Output (Temp_Output);
    end Capture_Output;

    procedure Terminate_Execution is
        Output : Io.File_Type;
    begin
        Log.Reset_Output;

        Io.Put_Line (Report_File, Indent &
                                     "OUTPUT FROM EXECUTION BETWEEN DASHES:");
        Io.Put_Line (Report_File, Indent & "---------------------");
        Io.Open (Output, Io.In_File, Temp_Output);

        while not Io.End_Of_File (Output) loop
            Io.Put_Line (Report_File, Io.Get_Line (Output));
        end loop;

        Io.Put_Line (Report_File, Indent & "---------------------");
        Io.Delete (Output);
    exception
        when Io.Name_Error =>
            null;
    end Terminate_Execution;

    procedure Exception_Raise (Exception_Name : String) is
    begin
        Io.Put (Report_File, Exception_Name & " exception raised");
        Io.New_Line (Report_File);
    end Exception_Raise;

    procedure Comment (Comments : String) is
    begin
        Io.Put (Report_File, Indent & Comments);
    end Comment;

    procedure Passed is
    begin
        Io.Put (Report_File, Indent & "!!! PASSED !!!");
        Io.New_Line (Report_File);
    end Passed;

    procedure Failed is
    begin
        Io.Put (Report_File, Indent & "*** FAILED ***");
        Io.New_Line (Report_File);
    end Failed;

    procedure New_Line (Repeat : Positive := 1) is
    begin
        Io.New_Line (Report_File, Io.Positive_Count (Repeat));
    end New_Line;
    package Duration_Io is new Io.Fixed_Io (Duration);

    procedure Value (Parameter_Name : String;
                     Value : Duration;
                     Indent : Natural := 4) is
        Indentation : constant String (1 .. Indent) := (others => ' ');
    begin
        Io.Put (Report_File, Indentation & Parameter_Name & ": ");
        Duration_Io.Put (Report_File, Value);
        Io.New_Line (Report_File);

    end Value;
end Report;