C*****************************************************************************
C
C                  Test of File-Oriented Syslib Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: FileOriented/ FileO.For
C Author	: John Malcolmson
C Date		: June 1986
C Language	: Fortran 77
C Note		: Uses subroutines imported from both syslib and RTNS 
C		  libraries.
C
C*****************************************************************************

C*****************************************************************************
C
C List of functions:
C	(I)CloseC, IDelete, IEnter, IFprot, IRenam, ISfdat, Lookup
C
C*****************************************************************************


C-------------------------------- (I)CLOSEC ----------------------------------

	Function TstCloseC

		Integer*4	TstCloseC
		Integer*2	CloseC, Iclose, Ienter, Lookup
		Integer*2	res
		Integer*2	Ichan
		Real*8		Spec


		Call CenterString( '--- Testing (I)CLOSEC ---\' )
		Call WriteLn
		Call CenterString(
	1 'Close specified channel w/o result codes\')
		Call WriteLn
		TstCloseC = 0
			
		Ichan = IGetc()

		res = Iclose( Ichan )
		IF (res .ne. 0) THEN
			Call RsltFail( 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**1
		END IF

		res = CloseC( Ichan )
		IF (res .ne. 0) THEN
			Call RsltFail( 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**2
		END IF

		Call Iclose( Ichan, res )
		IF (res .ne. 0) THEN
			Call RsltFail( 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**3
		END IF

		Call CloseC( Ichan, res )
		IF (res .ne. 0) THEN
			Call RsltFail( 4 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**4
		END IF

		Call IRad50(12, 'DATTEST01TXT', Spec )
		res = Lookup( Ichan, Spec )

		IF (res .lt. 1) THEN
			Call MtFail( 'Tfile!\', 5 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**5
		END IF
	
		res = IClose( Ichan )

		IF (res .ne. 0) THEN
			Call RsltFail( 6 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**6
		END IF

		Call IRad50(12, 'DATTESTAATST', Spec )
		res = Ienter( Ichan, Spec, 1 )

		IF (res .lt. 0) THEN
			Call MtFail( 'Tfile!\', 7 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**7
		END IF
	
		res = CloseC( Ichan )

		IF (res .ne. 0) THEN
			Call RsltFail( 8 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**8
		END IF

		res = Idelet( Ichan, Spec )

		IF (res .ne. 0) THEN
			Call MtFail( 'F-Del!\', 9 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCloseC = TstCloseC + 2**9
		END IF

		Call CloseC( Ichan )
		Call IFreeC( Ichan )

		Call TestFail( TstCloseC )

		Call CenterString( '--- Testing (I)CLOSEC completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C--------------------------------- IDELETE -----------------------------------

	Function TstIDelete

		Integer*4	TstIDelete
		Integer*2	IDelet, Ienter, Lookup
		Integer*2	res, Ichan
		Real*8		Spec

		Call CenterString( '--- Testing IDELET ---\' )
		Call WriteLn
		Call CenterString(
	1 'Deletes specified file with result codes\')
		Call WriteLn
		TstIDelete = 0

		Ichan = IGetC()

		Call Irad50( 12, 'DATTEST02TXT', Spec )
		res = Idelet( Ichan, Spec )

		IF (res .ne. 4) THEN
			Call MtFail( 'prtctd\', 1 )
			Call Write2Int( 4,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIdelete = TstIdelete + 2**1
		END IF
		
		Call Irad50( 12, 'DATTEST01TXT', Spec )
		Call Fallt(Lookup(Ichan,Spec),'*** Lookup Failure 01.01 ***\')
		res = Idelet( Ichan, Spec )
		IF (res .ne. 1) THEN
			Call MtFail( 'Alyopn\', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIDelete = TstIDelete + 2**2
		END IF

		Call CloseC( Ichan )
		Call Irad50( 12, 'DATTEST00TST', Spec )
		res = Idelet( Ichan, Spec )
		IF (res .ne. 2) THEN
			Call MtFail( 'FNFnd!\', 3 )
			Call Write2Int( 2,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIDelete = TstIDelete + 2**3
		END IF

		Call IRad50(12, 'DATTESTAATST', Spec )
		res = Ienter( Ichan, Spec, 1 )

		IF (res .lt. 0) THEN
			Call MtFail( 'Tfile!\', 4 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIdelete = TstIdelete + 2**4
		END IF
	
		Call IClose( Ichan )
		Call Idelet( Ichan, Spec )	

		res = Lookup( Ichan, Spec )

		IF (res .ge. 1) THEN
			Call MtFail( 'FNFnd!\', 5 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIdelete = TstIdelete + 2**5
		END IF

		Call CloseC( Ichan )
		Call IFreeC( Ichan )
		
		Call TestFail( TstIdelete )

		Call CenterString( '--- Testing IDELET completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C----------------------------------- IENTER ----------------------------------

	Function TstIenter

		Integer*4	TstIenter
		Integer*2	Ienter, res, Idelet, Lookup, Ichan
		Real*8		Spec

		Call CenterString( '--- Testing IENTER ---\' )
		Call WriteLn
		Call CenterString(
	1 'Creates a new file with result codes\')
		Call WriteLn
		TstIenter = 0

c  Create a new 1-block file and then try to open it.

		Ichan = IgetC()
		Call IRad50(12, 'DATTESTAATST', Spec )
		res = Ienter( Ichan, Spec, 1 )

		IF (res .ne. 1) THEN
			Call MtFail( 'Tfile!\', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIenter = TstIenter + 2**1
		END IF
		Call IWritW( 4, spec, 0, ichan)		! write block 0
		Call IClose( Ichan )

		res = Lookup( Ichan, Spec )

		IF (res .ne. 1) THEN
			Call MtFail( 'F-Fnd!\', 2 )
			Call Write2Int(  1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIenter = TstIenter + 2**2
		END IF
		
		Call CloseC( Ichan )
		Call Idelet( Ichan, Spec )

c  Try to create a file that already exists and is protected.

		Call IRad50(12, 'DATTEST02TXT', Spec )
		res = Ienter( Ichan, Spec, 1 )

		IF (res .ne. -4) THEN
			Call MtFail( 'prtctd\', 3 )
			Call Write2Int( -4,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIenter = TstIenter + 2**3
		END IF

		Call Purge( Ichan )

c  Try to create a file using a channel that is already in use.

		Call Fallt(Lookup(Ichan,Spec),'*** Lookup Failure 02.01 ***\')

		res = Ienter( Ichan, Spec, 1 )

		IF (res .ne. -1) THEN
			Call MtFail( 'Cinuse\', 4 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIenter = TstIenter + 2**4
		END IF
	
		Call CloseC( Ichan )

c  Try to create a file that won't fit on the device.

		Call IRad50(12, 'DATTESTCCTST', Spec )
		res = Ienter( Ichan, Spec, 65527 )
		IF (res .ne. -2) THEN
			Call MtFail( 'NoSpce\', 5 )
			Call Write2Int( -2,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIenter = TstIenter + 2**5
		END IF
		
		Call CloseC( Ichan )
		Call IFreeC( Ichan )

c  Display test summary for IENTER

		Call TestFail( TstIenter )
		Call CenterString( '--- Testing IENTER completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C----------------------------------- IFPROT ----------------------------------

	Function TstIfprot

		Integer*4	TstIfprot
		Integer*2	Ifprot, Idelete, Ienter, res
		Real*8		Spec


		Call CenterString( '--- Testing IFPROT ---\' )
		Call WriteLn
		Call CenterString(
	1 'Sets or removes protection with result codes\')
		Call WriteLn
		TstIfprot = 0

c  Try to protect a file that doesn't exist

		Ichan = Igetc()
		Call Irad50( 12, 'DATTESTQQTST', Spec )
		res = Ifprot( Ichan, Spec, 0 )
		IF (res .ne. 2) THEN
			Call MtFail( 'F-NFnd\', 1 )
			Call Write2int( 2,   10 )
			Call Write2int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**1
		END IF
		
c  Specify an invalid protection value

		res = Ifprot( Ichan, Spec, 100 )
		IF (res .ne. 4) THEN
			Call RsltFail( 2 )
			Call Write2Int( 4,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**2
		END IF

c  Try to protect a file that is already open - channel in use

		Call CloseC( Ichan )
		Call Irad50( 12, 'DATTEST01TXT', Spec )
		Call Fallt(Lookup(Ichan,Spec),'*** Lookup Failure 03.01 ***\')
		res = IfProt( Ichan, Spec, 1 )
		IF ( Res .ne. 1) THEN
			Call MtFail( 'Alyopn\', 3 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**3
		END IF

c  Create a temporary file and protect it.

		Call Closec( Ichan )
		Call Irad50( 12, 'DATTESTBBTST', Spec )
		Call Ienter( Ichan, spec, 1 )
		Call CloseC( Ichan )
		res = IfProt( Ichan, Spec, 1 )
		IF (res .ne. 0) THEN
			Call RsltFail( 4 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**4
		END IF

c  Try to delete the protected file.  It should report "Protected file".

		res = Idelet( Ichan, Spec )
		IF (res .ne. 4) THEN
			Call MtFail( 'prtctd\', 5 )
			Call Write2Int( 4,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**5
		END IF

c  Unprotect the file

		res = IfProt( Ichan, Spec, 0 )
		IF (res .ne. 0) THEN
			Call RsltFail( 6 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**6
		END IF

c  Now delete it.

		res = Idelet( Ichan, Spec )
		IF (res .ne. 0) THEN
			Call MtFail( 'unprot\', 7 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIfprot = TstIfprot + 2**7
		END IF

		Call CloseC( Ichan )
		Call IFreeC( Ichan )

c  Print a summary for the test

		Call TestFail( TstIfprot )

		Call CenterString( '--- Testing IFPROT completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C----------------------------------- IRENAM ----------------------------------

	Function TstIrenam

		Integer*4	TstIrenam
		Integer*2	res, Lookup, Irenam
		Real*8		Spec(2)

		Call CenterString( '--- Testing IRENAM ---\' )
		Call WriteLn
		Call CenterString(
	1 'Changes the name of a file with result codes\')
		Call WriteLn
		TstIrenam = 0

		Ichan = Igetc()

		Call Irad50( 12, 'DATTEST04TST', Spec(1) )
		Call Irad50( 12, 'DATTEST05TST', Spec(2) )
		res = Irenam( Ichan, Spec )
		IF (res .ne. 2) THEN
			Call MtFail( 'F-NFnd\', 1 )
			Call Write2Int( 2,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrenam = TstIrenam + 2**1
		END IF

		Call Irad50( 12, 'DATTEST03TXT', Spec(1) )
		Call Irad50( 12, 'DATTEST02TXT', Spec(2) )
		res = Irenam( Ichan, Spec )
		IF (res .ne. 4) THEN
			Call MtFail( 'prtctd\', 2 )
			Call Write2Int( 4,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrenam = TstIrenam + 2**2
		END IF
	
		Call CloseC( Ichan )

20		res = Lookup( Ichan, Spec(1) )
		IF (res .eq. -3) Goto 20
		Call Irad50( 12, 'DATTEST03TXT', Spec(1) )
		Call Irad50( 12, 'DATTEST04TST', Spec(2) )
		res = Irenam( Ichan, Spec )
		IF (res .ne. 1) THEN
			Call MtFail( 'Alyopn\', 3 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrenam = TstIrenam + 2**3
		END IF

		Call CloseC( Ichan )

		res = Lookup( Ichan, Spec(2) )
		IF (res .gt. 0) THEN
			Call MtFail( 'functn\', 4 )
			Call Write2Int( -2,   10 )
			Call Write2Int( res,  10 )
			Call WriteLn
			TstIrenam = TstIrenam + 2**4
			Call CloseC( IChan )
			Call Irad50( 12, 'DATTEST03TXT', Spec(2) )
			Call Irad50( 12, 'DATTEST04TST', Spec(1) )
			res = Irenam( Ichan, Spec )
		END IF

		Call CloseC( Ichan )
		Call Irad50( 12, 'DATTEST05TST', Spec(1) )
		Call Irad50( 12, 'DATTEST04TST', Spec(2) )
			
		Call Ienter( Ichan, Spec(1), 1 )
		Call CloseC( Ichan )
		res = Irenam( Ichan, Spec )
		IF (res .ne. 0) THEN
			Call MtFail( 'RENAME\', 5 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrenam = TstIrenam + 2**5
		END IF
		Call CloseC( Ichan )
		res = Lookup( Ichan, Spec(2) )
		IF (res .ge. 1) THEN
			Call MtFail( 'RENAME\', 6 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIrenam = TstIrenam + 2**6
		END IF

		Call CloseC( Ichan )

		Call Idelet( Ichan, Spec(1) )
		Call Idelet( Ichan, Spec(2) )

		Call CloseC( Ichan )
		Call IFreeC( Ichan )

		Call TestFail( TstIrenam )

		Call CenterString( '--- Testing IRENAM completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C----------------------------------- ISFDAT ----------------------------------

	Function TstIsfdat

		Integer*4	TstIsfdat
		Integer*2	res, Isfdat, Idate, Ichan
		Real*8		Spec

		Call CenterString( '--- Testing ISFDAT ---\' )
		Call WriteLn
		Call CenterString(
	1 'Changes the date on a file with result codes\')
		Call WriteLn
		TstIsfdat = 0

		Ichan = Igetc()

		Idate = 7*1024 + 4*32 + (1976 - 1972)
		Call Irad50( 12, 'DATTESTQQTST', Spec )
		res = Isfdat( Ichan, Spec, Idate )
		IF (res .ne. 2) THEN
			Call MtFail( 'F-NFnd\', 1 )
			Call Write2int( 2,   10 )
			Call Write2int( res, 10 )
			Call WriteLn
			TstIsfdat = TstIsfdat + 2**1
		END IF
		
		Call Irad50( 12, 'DATTEST03TXT', Spec )
		res = Isfdat( Ichan, Spec, Idate )
		IF (res .ne. 0) THEN
			Call RsltFail( 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsfdat = TstIsfdat + 2**2
		END IF

		Call CloseC( Ichan )
		Call Irad50( 12, 'DATTEST01TXT', Spec )
		Call Fallt(Lookup(Ichan,Spec),'*** Lookup Failure 04.01 ***\')
		res = Isfdat( Ichan, Spec, Idate )
		IF ( Res .ne. 1) THEN
			Call MtFail( 'Alyopn\', 3 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIsfdat = TstIsfdat + 2**3
		END IF

C	Commented out because Isfdat will return success on some devices
C	because of internal limitations, even in error conditions.
C		Call Closec( Ichan )
C		Call Irad50( 12, 'TT          ',Spec )
C		res = Isfdat( Ichan, Spec, Idate )
C		IF (res .ne. 3) THEN
C			Call RsltFail( 4 )
C			Call Write2Int( 3,   10 )
C			Call Write2Int( res, 10 )
C			Call WriteLn
C			TstIsfdat = TstIsfdat + 2**4
C		END IF

		Call CloseC( Ichan )
		Call IFreeC( Ichan )


		Call TestFail( TstIsfdat )

		Call CenterString( '--- Testing ISFDAT completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C---------------------------------- LOOKUP -----------------------------------

	Function TstLookup

		Integer*4	TstLookup
		Integer*2	Ichan, Igetc, Lookup, res
		Real*8		Spec

		Call CenterString( '--- Testing LOOKUP ---\' )
		Call WriteLn
		Call CenterString(
	1 'Opens a specified file with result codes\')
		Call WriteLn
		TstLookup = 0
		Ichan = Igetc()
		Call Closec( Ichan )
		
		Call Irad50( 12, 'DATTEST01TXT', Spec )
		res = LookUp( Ichan, Spec )
		IF (res .lt. 1) THEN
			Call MtFail( 'LOOKUP\', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstLookup = TstLookup + 2**1
		END IF

		Call CloseC( Ichan )

		Call Irad50( 12, 'DATTESTWWTST', Spec )
		res = LookUp( Ichan, Spec )
		IF (res .ne. -2) THEN
			Call RsltFail( 2 )
			Call Write2Int( -2,   10 )
			Call Write2Int( res,  10 )
			Call WriteLn
			TstLookup = TstLookup + 2**2
		END IF

		Call CloseC( Ichan )

		Call Irad50( 12, 'DATTEST02TXT', Spec )
		Call Fallt(Lookup(Ichan,Spec),'*** Lookup Failure 05.01 ***\')
		res = Lookup( Ichan, Spec )
		IF (Res .ne. -1) THEN
			Call RsltFail( 3 )
			Call Write2Int( -1,   10 )
			Call Write2int( res,  10 )
			Call WriteLn
			TstLookup = TstLookup + 2**3
		END IF

		Call CloseC( Ichan )
		Call IFreeC( Ichan )

		Call TestFail( TstLookup )

		Call CenterString( '--- Testing LOOKUP completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END

C------------------------------ Corruption Check -----------------------------

	Function TstCorr

		Integer*4	TstCorr
		Integer*2	Ichan, Igetc, Lookup, res
		Real*8		Spec

		Call CenterString( '--- Testing For Test-File Corruption ---\' )
		Call WriteLn
		Call CenterString( 'Ensures that the syslib tests are valid\')
		Call WriteLn
		Tstcorr = 0
		Ichan = Igetc()
		Call Closec( Ichan )
		
		Call Irad50( 12, 'DATTEST01TXT', Spec )
		res = LookUp( Ichan, Spec )
		IF (res .lt. 1) THEN
			Call MtFail( 'Test01\', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCorr = TstCorr + 2**1
		END IF

		Call CloseC( Ichan )
		Call Irad50( 12, 'DATTEST02TXT', Spec )
		res = LookUp( Ichan, Spec )
		IF (res .lt. 1) THEN
			Call MtFail( 'Test02\', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCorr = TstCorr + 2**2
		END IF

		Call CloseC( Ichan )
		Call Irad50( 12, 'DATTEST03TXT', Spec )
		res = LookUp( Ichan, Spec )
		IF (res .lt. 1) THEN
			Call MtFail( 'Test03\', 3 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstCorr = TstCorr + 2**3
		END IF

		Call CloseC( Ichan )
		Call IFreeC( Ichan )

		Call TestFail( TstCorr )

		Call CenterString( '--- Testing for corruption completed ---\' )
		Call WriteLn
		Call WriteLn
		Return

	END