DataMuseum.dk

top - download

    Length: 5832 (0x16c8)
    Types: TextFile
    Names: »B«

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦49e7f20b9⟧ 
                └─⟦this⟧ 

TextFile

--/ if R1000 then
with Debug_Tools;
--/ end if;

with Capitalize;  
with Lower_Case;  
with Test_Io;  
use Test_Io;

with Xlbt_Exceptions;  
use Xlbt_Exceptions;

procedure Run_One_Test is
------------------------------------------------------------------------------
-- X Library Testing
--
-- Run_One_Test - Handles running one test in a suite.
------------------------------------------------------------------------------
-- Copyright 1990 - 1990 by Rational, Santa Clara, California.
--
--                  All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------
--
-- Called to run one test program and to log the results of the run.  Compares
-- the new results with saved old results.
--
------------------------------------------------------------------------------
--\f

----Names of the files we care about in the current working directory.

    Our_Test_Name : constant String := Capitalize (Test_Name);  
    Old_Log       : constant String :=  
       Lower_Case (Append_File_Extension (Our_Test_Name, "Log"));  
    New_Log       : constant String :=  
       Lower_Case (Append_File_Extension (Our_Test_Name, "Tmp"));

    procedure Report_Exception (Name : String) is
------------------------------------------------------------------------------
--  Name    - Specifies the implementation-dependent name string
--
-- Used to print out reports on unexpected exceptions.  We put one notice
-- into the log and the other to Standard_Output after resetting the log.
------------------------------------------------------------------------------
    begin

        Put_Exception (Our_Test_Name &  
                       ": unexpected Constraint_Error: " & Name);  
        Pop_Output;

    end Report_Exception;

begin

----Set the log file so we can record everything.

    Put_Aux ("Test: " & Our_Test_Name & " - " & Test_Description);  
    Push_Output (New_Log, Duplicate => False);

----Perform the test.

    begin  
        The_Test;  
    exception

----If we get an exception then close the log file and report the error.

--/ if R1000 then

        when others =>  
            Report_Exception (Debug_Tools.Get_Exception_Name (True, True));  
            return;

--/ else
--//
--//         when Constraint_Error =>
--//             Report_Exception ("Constraint_Error");
--//             return;
--//
--//         when Numeric_Error =>
--//             Report_Exception ("Numeric_Error");
--//             return;
--//
--//         when Storage_Error =>
--//             Report_Exception ("Storage_Error");
--//             return;
--//
--//         when Program_Error =>
--//             Report_Exception ("Program_Error");
--//             return;
--//
--//         when X_Network_Io_Error =>
--//             Report_Exception ("Xlib X_Network_Io_Error");
--//             return;
--//
--//         when X_Unhandled_Error =>
--//             Report_Exception ("Xlib X_Unhandled_Error");
--//             return;
--//
--//         when X_Invalid_Procedure_Variable =>
--//             Report_Exception ("Xlib X_Invalid_Procedure_Variable");
--//             return;
--//
--//         when X_Bad_Procedure_Variable =>
--//             Report_Exception ("Xlib X_Bad_Procedure_Variable");
--//             return;
--//
--//         when X_Invalid_Universal_Pointer =>
--//             Report_Exception ("Xlib X_Invalid_Universal_Pointer");
--//             return;
--//
--//         when X_Library_Confusion =>
--//             Report_Exception ("Xlib X_Library_Confusion");
--//             return;
--//
--//         when others =>
--//             Report_Exception ("<name unknown>");
--//             return;
--//
--/ end if;

    end;

----Test is over.  Close the log file.

    Pop_Output;

----If there is no saved log file then complain and exit.

    if not File_Exists (Old_Log) then  
        Put_Error ("diff: " & Our_Test_Name &  
                   ": no saved _Log file to compare.");  
        return;  
    end if;

----Compare the tmp and the log files.  They must be equal.

    if not Files_Equal (Old_Log,  
                        New_Log,  
                        Ignore_Case        => Ignore_Case,  
                        Ignore_Blank_Lines => Ignore_Blank_Lines) then

----If the files are not equal then complain.  DIFF them if we aren't using
--  special options to Equal (that Difference doesn't have).

        Put_Error ("diff: " & Our_Test_Name & ": new/old logs differ.");  
        Files_Diff (File1              => Old_Log,  
                    File2              => New_Log,  
                    Ignore_Case        => Ignore_Case,  
                    Ignore_Blank_Lines => Ignore_Blank_Lines);

----Delete the tmp file if the same as the log file.

    else  
        File_Delete (New_Log);  
    end if;

----We are done.

    Put_Aux ("Done: " & Our_Test_Name);

end Run_One_Test;