MODULE XTESTF ( IDENT = '00.09',		%TITLE 'File-spec Resolution Test'
		MAIN = TEST_FILE_SPEC
		) =
BEGIN

!
!			  COPYRIGHT (c) 1979 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 XPO$FILE_SPEC.
!
! ENVIRONMENT:  User-mode - system independent
!
! AUTHOR:  Ward Clark,	CREATION DATE:  15 January 1979
!
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    TEST_FILE_SPEC;					! XPO$FILE_SPEC test routine

!
! INCLUDE FILES:
!

LIBRARY  'XPORT';					! XPORT control block and interface macros

!
! 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
    terminal :  $XPO_IOB(),				! terminal IOB
    file :  $XPO_IOB();					! data file IOB

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    XPO$IO_FAILURE;					! Non-terminating I/O failure action routine

GLOBAL ROUTINE TEST_FILE_SPEC =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine tests XPO$FILE_SPEC.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION CODES:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    LOCAL
	user_spec :  $STR_DESCRIPTOR(),			! User file specification descriptor
	default_spec :  $STR_DESCRIPTOR(),		! Default file specification descriptor
	related_spec :  $STR_DESCRIPTOR();		! Related file specification descriptor
 
%IF %VARIANT NEQ 0 %THEN
!
! Initialize all IOB's
!

    $XPO_IOB_INIT( IOB = terminal );
    $XPO_IOB_INIT( IOB = file );
%FI

!
! Initialize all string descriptors.
!

    $STR_DESC_INIT( DESCRIPTOR = user_spec,		! Initialize the three file-spec descriptors.
			CLASS = DYNAMIC );
    $STR_DESC_INIT( DESCRIPTOR = default_spec,
			CLASS = DYNAMIC );
    $STR_DESC_INIT( DESCRIPTOR = related_spec,
			CLASS = DYNAMIC );

!
! Open the terminal input file and send a greeting.
!

    $XPO_OPEN( IOB = terminal,				! Open the terminal file:
	FILE_SPEC =$XPO_INPUT,				!    standard input file
	OPTIONS = (INPUT,OUTPUT) );			!    input and output file

    $XPO_PUT( IOB = terminal,				! Send the user a greeting message.
	STRING = skip('XPORT File-spec Resolution Test') );

!
! Update the three file specifications.
!

    WHILE 1 DO						! Loop forever.
	BEGIN
	IF NOT $XPO_GET( IOB = terminal,		! Ask for a user file specification.
		PROMPT = skip('User file specification? ') )
	THEN
	    EXITLOOP;

	IF .terminal[IOB$H_STRING] NEQ 0		! If a user file specification is specified,
	THEN						!
	    $STR_COPY( STRING = terminal[IOB$T_STRING],	! save it for later.
			TARGET = user_spec );

	IF NOT $XPO_GET( IOB = terminal,		! Ask for a default file specification.
		PROMPT = ('Default file specification? ') )
	THEN
	    EXITLOOP;

	IF .terminal[IOB$H_STRING] NEQ 0		! If a default file specification is specified,
	THEN						!
	    $STR_COPY( STRING = terminal[IOB$T_STRING],	! save it for later.
			TARGET = default_spec );

	IF NOT $XPO_GET( IOB = terminal,		! Ask for a related file specification.
		PROMPT = ('Related file specification? ') )
	THEN
	    EXITLOOP;

	IF .terminal[IOB$H_STRING] NEQ 0		! If a related file specification is specified,
	THEN						!
	    $STR_COPY( STRING = terminal[IOB$T_STRING],	! save it for later.
			TARGET = related_spec );

!
! Open the resultant file and display its name.
!

	IF $XPO_OPEN( IOB = file,			! Open the resultant file.
		FILE_SPEC = user_spec,
		DEFAULT = default_spec,
		RELATED = related_spec,
		OPTIONS = INPUT,
		FAILURE = 0 )
	THEN
	    file[IOB$G_COMP_CODE] = 2;			! Force a failure completion code.

	XPO$IO_FAILURE( XPO$K_IO,			! Use failure action routine to display resultant file name.
			.file[IOB$G_COMP_CODE],
			file );

!
! Close the file if necessary.
!

	IF .file[IOB$V_OPEN]				! If the file was opened,
	THEN						!
	    $XPO_CLOSE( IOB = file );			! close it.

	END;

!
! Send a test completion message.
!

    $XPO_PUT( IOB = terminal,				! Tell the user that the testing is done.
	STRING = skip('XPORT File-spec Resolution Testing Complete') )
    END;
END
ELUDOM