|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package Test_Io, seg_00563e
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦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.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- 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;
nblk1=e
nid=0
hdr6=1c
[0x00] rec0=19 rec1=00 rec2=01 rec3=050
[0x01] rec0=11 rec1=00 rec2=02 rec3=06e
[0x02] rec0=15 rec1=00 rec2=03 rec3=03c
[0x03] rec0=15 rec1=00 rec2=04 rec3=002
[0x04] rec0=14 rec1=00 rec2=05 rec3=002
[0x05] rec0=16 rec1=00 rec2=06 rec3=060
[0x06] rec0=17 rec1=00 rec2=07 rec3=048
[0x07] rec0=16 rec1=00 rec2=08 rec3=07c
[0x08] rec0=18 rec1=00 rec2=09 rec3=010
[0x09] rec0=14 rec1=00 rec2=0a rec3=018
[0x0a] rec0=13 rec1=00 rec2=0b rec3=028
[0x0b] rec0=12 rec1=00 rec2=0c rec3=044
[0x0c] rec0=16 rec1=00 rec2=0d rec3=02a
[0x0d] rec0=10 rec1=00 rec2=0e rec3=000
tail 0x21700aa6c81978d5679c4 0x42a00088462063203