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 - downloadIndex: ┃ T V ┃
Length: 13389 (0x344d) Types: TextFile Names: »V«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00 └─ ⟦0c20f784e⟧ »DATA« └─⟦1abbe589f⟧ └─⟦49e7f20b9⟧ └─⟦this⟧
with Xlbt_Arithmetic; use Xlbt_Arithmetic; with Xlbt_String; use Xlbt_String; package Test_Io is ------------------------------------------------------------------------------ -- X Library Testing -- -- Test_Io - Basic I/O facilities for the tests. ------------------------------------------------------------------------------ -- 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. ------------------------------------------------------------------------------ --\f ------------------------------------------------------------------------------ -- Log File Controls ------------------------------------------------------------------------------ procedure Push_Output (File : String; Duplicate : Boolean := True); ------------------------------------------------------------------------------ -- File - Specifies the name of the new output file -- Duplicate - Specifies TRUE if output should go to all stacked outputs -- -- Opens the file for writing and sets it so that it is used for future output. -- -- Duplicate => FALSE will block normal output from duplication in "outer" -- log files. If another Push is done with Duplicate => TRUE then output -- will go to that file and this one but no further because this one has -- Duplicate => FALSE which blocks further output. -- -- Put_Error and Put_Exception ignore the Duplicate flag. ------------------------------------------------------------------------------ procedure Pop_Output; ------------------------------------------------------------------------------ -- Closes the current output file and reverts to the previous output file. -- Raises Constraint_Error if there was no previous file. ------------------------------------------------------------------------------ --\f ------------------------------------------------------------------------------ -- Log File Output ------------------------------------------------------------------------------ procedure Put_Aux (Msg : String); ------------------------------------------------------------------------------ -- Msg - Specifies the ::: error message to put out. -- -- Put out "::: " and Msg to all active outputs regardless of Duplicate flag. ------------------------------------------------------------------------------ procedure Put_Error (Msg : String); ------------------------------------------------------------------------------ -- Msg - Specifies the *** error message to put out. -- -- Put out "*** " and Msg to all active outputs regardless of Duplicate flag. ------------------------------------------------------------------------------ procedure Put_Exception (Msg : String); ------------------------------------------------------------------------------ -- Msg - Specifies the %%% error message to put out. -- -- Put out "%%% " and Msg to all active outputs regardless of Duplicate flag. ------------------------------------------------------------------------------ procedure Section (Name : String); ------------------------------------------------------------------------------ -- Name - Specifies the name of a "section" in the log file -- -- Called within tests so that we can log "where we are" while running a test. -- Some tests will have many "parts" and each part will start by identifying -- itself to the log. This helps when initially tracking down bugs that show -- up when running the regression tests. ------------------------------------------------------------------------------ procedure New_Line (Spacing : Positive := 1); ------------------------------------------------------------------------------ -- Spacing - Specifies the number of new-lines to produce -- -- Called to go to a new line in the log file. ------------------------------------------------------------------------------ procedure Set_Col (To : Positive); ------------------------------------------------------------------------------ -- To - Specifies the column to go to, 1..N -- -- Used to put out column information in the log file. Helps when you want -- various things to line up in the log. ------------------------------------------------------------------------------ procedure Put (Ch : Character); ------------------------------------------------------------------------------ -- Ch - Specifies the character to put out -- -- Used to put one character into the log. ------------------------------------------------------------------------------ procedure Put (Str : String); ------------------------------------------------------------------------------ -- Str - Specifies the string to put out -- -- Used to put a string into the log. ------------------------------------------------------------------------------ procedure Put_Line (Str : String); ------------------------------------------------------------------------------ -- Str - Specifies the string to put out -- -- Used to put a string into the log and ends it in a new-line. ------------------------------------------------------------------------------ procedure Putx (Str : X_String); ------------------------------------------------------------------------------ -- Str - Specifies the string to put out -- -- Used to put a string into the log. ------------------------------------------------------------------------------ procedure Putx_Line (Str : X_String); ------------------------------------------------------------------------------ -- Str - Specifies the string to put out -- -- Used to put a string into the log and ends it in a new-line. ------------------------------------------------------------------------------ procedure Put (Int : Integer; Width : Natural := 1; Base : Positive := 10); ------------------------------------------------------------------------------ -- Int - Specifies the integer value -- Width - Specifies the width of the output -- Base - Specifies the base of the output -- -- Used to put an integer into the log; base 10. ------------------------------------------------------------------------------ procedure Hex (Int : Integer; Width : Natural := 1; Base : Positive := 16); ------------------------------------------------------------------------------ -- Int - Specifies the integer value -- Width - Specifies the width of the output -- Base - Specifies the base of the output -- -- Used to put an integer into the log; base 16. ------------------------------------------------------------------------------ procedure Put (Ul : S_Long; Width : Natural := 1; Base : Positive := 10); ------------------------------------------------------------------------------ -- Int - Specifies the S_Long value -- Width - Specifies the width of the output -- Base - Specifies the base of the output -- -- Used to put an S_Long into the log; base 10. ------------------------------------------------------------------------------ procedure Hex (Ul : S_Long; Width : Natural := 1; Base : Positive := 16); ------------------------------------------------------------------------------ -- Int - Specifies the S_Long value -- Width - Specifies the width of the output -- Base - Specifies the base of the output -- -- Used to put an S_Long into the log; base 16. ------------------------------------------------------------------------------ --\f ------------------------------------------------------------------------------ -- System Dependent File Manipulations ------------------------------------------------------------------------------ Test_Io_Error : exception; function Append_File_Extension (File : String; Extension : String) return String; ------------------------------------------------------------------------------ -- File - Specifies the basic name of the file, eg. "foobar". -- Extension - Specifies the extension to give to the file, eg. "log". -- -- Adds the Extension to the File with the appropriate system-dependent -- character(s) in between. Eg. "foobar.log" or "foobar_log" ------------------------------------------------------------------------------ function File_Context (File : String) return String; ------------------------------------------------------------------------------ -- File - Specifies a file name -- -- Returns the path portion of the name. Returns something like "$" or "." -- for files that have no explicit path. ------------------------------------------------------------------------------ procedure File_Delete (File : String); ------------------------------------------------------------------------------ -- File - Specifies the file to delete -- -- Called to delete a particular file. Raises Test_Io_Error if it can't -- delete the file. Also puts a message out to the log. ------------------------------------------------------------------------------ function File_Exists (File : String) return Boolean; ------------------------------------------------------------------------------ -- File - Specifies the name of the file to check for -- -- Called to check to see whether or not a file exists and is readable. ------------------------------------------------------------------------------ function Files_Equal (File1 : String; File2 : String; Ignore_Case : Boolean; Ignore_Blank_Lines : Boolean) return Boolean; ------------------------------------------------------------------------------ -- File1 - Specifies the name of the first file -- File2 - Specifies the name of the second file -- -- We do a "fast" comparison of the two files. Our only concern is 'equality'. -- call the File_Difference routine for a diff output. ------------------------------------------------------------------------------ procedure Files_Diff (File1 : String; File2 : String; Ignore_Case : Boolean; Ignore_Blank_Lines : Boolean); ------------------------------------------------------------------------------ -- File1 - Specifies the name of the first file -- File2 - Specifies the name of the second file -- -- We do a simple minded "diff" of two files and send the output to the log. -- We don't expect to handle megabytes of stuff so don't be surprised if we -- blow up on very large files. We bring the entirity of both files into -- memory. ------------------------------------------------------------------------------ procedure Resolve_Wildcards (Names : String; Extra : String); ------------------------------------------------------------------------------ -- Name - Specifies the name with wildcards -- Extra - Specifies extra stuff to go onto the end of the Name string -- -- Called to find all of the files referenced by the Name string. -- We process the Name string. It is expected to be in R1000 wildcard -- notation ($/^/./@ only are allowed). We change it to be suitable for -- the current system and then we append the Extra to it. -- Usage: -- Resolve_Wildcards( "@", ".exe" ); -- while not Wild_Done loop -- do_something( Wild_Current ); -- Wild_Next; -- end loop; ------------------------------------------------------------------------------ procedure Wild_Next; ------------------------------------------------------------------------------ -- Called to progress to the next wildcard. ------------------------------------------------------------------------------ function Wild_Current return String; ------------------------------------------------------------------------------ -- Called to obtain the current value of the wildcard. ------------------------------------------------------------------------------ function Wild_Done return Boolean; ------------------------------------------------------------------------------ -- Called to see if there are more wildcards available. ------------------------------------------------------------------------------ end Test_Io;