MODULE STESTI (	MAIN = test_integer,		%TITLE 'XPORT ASCII-to-Binary Test'
		IDENT = 'X00.03'
		%BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) )
		) =
BEGIN

!
!			  COPYRIGHT (c) 1980 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
!
! FACILITY:  BLISS Library
!
! ABSTRACT:
!
!	This module tests $STR_BINARY integer conversion.
!
! ENVIRONMENT:  User Mode
!
! AUTHOR:  Ward Clark,	CREATION DATE:  9 April 1980
!
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    test_integer,					! Principal testing routine
    display_integer :  NOVALUE;				! Integer display routine

!
! INCLUDE FILES:
!
LIBRARY  'BLI:XPORT' ;					! XPORT control block and macro definitions

!
! MACROS:
!

MACRO
    SKIP( literal_string ) =				! Prefix a literal string with a line-feed
	%STRING( %CHAR(lf), literal_string ) %;

!
! EQUATED SYMBOLS:
!

LITERAL
    lf = %O'12';					! ASCII line feed character

!
! OWN STORAGE:
!

OWN
    tty_input :  $XPO_IOB(),				! IOB for input from terminal

    tty_output :  $XPO_IOB(),				! IOB for output to terminal

    upper_string :  $STR_DESCRIPTOR( CLASS = DYNAMIC,	! Upper-case string descriptor
				STRING = (0,0) );

!
! EXTERNAL REFERENCES:
!

GLOBAL ROUTINE test_integer =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine tests $STR_BINARY integer conversion.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION CODES:
!
!	STR$_NORMAL - successful completion
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

%IF %VARIANT NEQ 0 %THEN
!
! Initialize the IOBs.
!

    $XPO_IOB_INIT( IOB = tty_input );
    $XPO_IOB_INIT( IOB = tty_output );
%FI

!
! Open the user's terminal for output and send the user a greeting message.
!

    $XPO_OPEN( IOB = tty_output, FILE_SPEC = $XPO_OUTPUT, OPTION = OUTPUT );

    $XPO_PUT( IOB = tty_output, STRING = skip('XPORT ASCII-to-Binary Integer Conversion Test') );

!
! Open the user's terminal for input.
!

    $XPO_OPEN( IOB = tty_input, FILE_SPEC = $XPO_INPUT );

!
! Ask the user for an integer string.
!

    WHILE $XPO_GET( IOB = tty_input, PROMPT = skip('Enter number: ') ) DO

!
! Convert the integer string to binary.
!

	BEGIN
	LOCAL
	    base,					! conversion base
	    integer,					! integer result
	    text :  $STR_DESCRIPTOR( CLASS = BOUNDED );	! integer string scanning descriptor

	$STR_COPY( STRING = tty_input[IOB$T_STRING],	! Create an upper-case version of the input string.
		    TARGET = upper_string,
		    OPTION = UP_CASE );

	$STR_DESC_INIT( DESCRIPTOR = text,
			CLASS = BOUNDED,
			STRING = upper_string );

	IF $STR_SCAN( REMAINDER = text, FIND = '%B''', SUBSTRING = text )
	THEN
	    BEGIN
	    $STR_SCAN( REMAINDER = text, STOP = '''', SUBSTRING = text );

	    IF $STR_BINARY( STRING = text, OPTION = BASE2, RESULT = integer, FAILURE = STR$B_FAILURE )
	    THEN
		display_integer( tty_input[IOB$T_STRING], .integer );
	    END

	ELSE IF $STR_SCAN( REMAINDER = text, FIND = '%O''', SUBSTRING = text )
	THEN
	    BEGIN
	    $STR_SCAN( REMAINDER = text, STOP = '''', SUBSTRING = text );

	    IF $STR_BINARY( STRING = text, OPTION = BASE8, RESULT = integer, FAILURE = STR$B_FAILURE )
	    THEN
		display_integer( tty_input[IOB$T_STRING], .integer );
	    END

	ELSE IF $STR_SCAN( REMAINDER = text, FIND = '%D''', SUBSTRING = text )
	THEN
	    BEGIN
	    $STR_SCAN( REMAINDER = text, STOP = '''', SUBSTRING = text );

	    IF $STR_BINARY( STRING = text, OPTION = BASE10, RESULT = integer, FAILURE = STR$B_FAILURE )
	    THEN
		display_integer( tty_input[IOB$T_STRING], .integer );
	    END

	ELSE IF $STR_SCAN( REMAINDER = text, FIND = '%X''', SUBSTRING = text )
	THEN
	    BEGIN
	    $STR_SCAN( REMAINDER = text, STOP = '''', SUBSTRING = text );

	    IF $STR_BINARY( STRING = text, OPTION = BASE16, RESULT = integer, FAILURE = STR$B_FAILURE )
	    THEN
		display_integer( tty_input[IOB$T_STRING], .integer );
	    END

	ELSE
	    BEGIN
	    $STR_SCAN( REMAINDER = text, SPAN = ' 	', SUBSTRING = text );
	    $STR_SCAN( REMAINDER = text, STOP = '	', SUBSTRING = text );
	    IF $STR_BINARY( STRING = text, OPTION = BASE10, RESULT = integer, FAILURE = STR$B_FAILURE )
	    THEN
		display_integer( tty_input[IOB$T_STRING], .integer );
	    END;
	END;

!
! Send the user a test completion message.
!

    $XPO_PUT( IOB = tty_output, STRING = skip('XPORT Integer Conversion Test Complete') );

    RETURN STR$_NORMAL;

    END;

%TITLE 'DISPLAY_INTEGER - Conversion Output Routine'

ROUTINE display_integer( string, integer ) :  NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine displays the integer value in several forms.
!
! FORMAL PARAMETERS:
!
!	string - address of the integer string descriptor
!	integer - binary value to be displayed
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN
    LOCAL
	prefix :  $STR_DESCRIPTOR( CLASS = DYNAMIC );

    $STR_DESC_INIT( DESCRIPTOR = prefix, CLASS = DYNAMIC );

    $STR_COPY( STRING = $STR_CONCAT( '"', .string, '" = ' ),
		TARGET = prefix );

    $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( prefix, $STR_ASCII( .integer ) ) );
    $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( prefix, '%B''', $STR_ASCII( .integer, BASE2 ), '''' ) );
    $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( prefix, '%O''', $STR_ASCII( .integer, BASE8 ), '''' ) );
    $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( prefix, '%X''', $STR_ASCII( .integer, BASE16 ), '''' ) );

    RETURN

    END;
END
ELUDOM