MODULE STESTF ( MAIN = test_format, %TITLE 'XPORT String Formatting 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 the $STR_FORMAT string conversion function. ! ! ENVIRONMENT: User Mode ! ! AUTHOR: Ward Clark, CREATION DATE: 16 April 1980 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE test_format; ! Principal testing 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 ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE test_format = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine tests the $STR_FORMAT string conversion function. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! STR$_NORMAL - successful completion ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN LOCAL string_length; %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 String Formatting Test') ); ! ! Open the user's terminal for input. ! $XPO_OPEN( IOB = tty_input, FILE_SPEC = $XPO_INPUT ); ! ! Ask the user for a string length. ! string_length = 0; WHILE $XPO_GET( IOB = tty_input, PROMPT = skip('Enter string length: ') ) DO BEGIN ! ! Convert the ASCII string length to binary. ! IF .tty_input[IOB$H_STRING] NEQ 0 THEN IF NOT $STR_BINARY( STRING = tty_input[IOB$T_STRING], RESULT = string_length, RANGE = ( 0, 255 ), FAILURE = STR$B_FAILURE ) THEN EXITLOOP; ! ! Ask the user for an ASCII string. ! IF NOT $XPO_GET( IOB = tty_input, PROMPT = 'Enter string: ' ) THEN EXITLOOP; ! ! Format the string in several ways. ! $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( 'default: "', $STR_FORMAT( tty_input[IOB$T_STRING], LENGTH = .string_length ), '"' ) ); $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( 'LEFT_JUSTIFY: "', $STR_FORMAT( tty_input[IOB$T_STRING], LEFT_JUSTIFY, LENGTH = .string_length ), '"' ) ); $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( 'CENTER: "', $STR_FORMAT( tty_input[IOB$T_STRING], CENTER, LENGTH = .string_length ), '"' ) ); $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( 'RIGHT_JUSTIFY: "', $STR_FORMAT( tty_input[IOB$T_STRING], RIGHT_JUSTIFY, LENGTH = .string_length ), '"' ) ); $XPO_PUT( IOB = tty_output, STRING = $STR_CONCAT( 'UP_CASE: "', $STR_FORMAT( tty_input[IOB$T_STRING], CENTER, UP_CASE, LENGTH = .string_length ), '"' ) ); END; ! ! Send the user a test completion message. ! $XPO_PUT( IOB = tty_output, STRING = skip('XPORT String Formatting Test Complete') ); RETURN STR$_NORMAL; END; END ELUDOM