DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ T V

⟦0f4ef3b18⟧ TextFile

    Length: 13389 (0x344d)
    Types: TextFile
    Names: »V«

Derivation

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

TextFile

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;