C***************************************************************************** C C Test of User Interactive Syslib Routines. C Importable Functions C C----------------------------------------------------------------------------- C C Program : User Interactive/ UserI.For C Author : John Malcolmson C Date : July 1986 C Revised : 15-Sep-89, R. Hamilton 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 GtLin, ICSI, ITTInR, ITTOuR, MTIn, MTOut, MTPrint, RCtrlO, SCCA, C ISCCA, Print C C***************************************************************************** C-------------------------------- UIGtlin ------------------------------------ Function UIGtlin Integer*4 UIGtlin Character*81 input Character*5 prmpt Byte Char, Char1 Logical*2 flg, YnQuery Call CentLn( '--- Testing GTLIN ---\' ) Call CentLn( 'Gets a line from the terminal\') UIGtlin = 0 Call WriteLn 5 Call CentLn('Please type the following line of text:\') Call WriteString(':> 1234567890qwertyuiop\',0,0) Call WriteLn Call Concat( ':> ', "200, prmpt ) Call GtLin( input, prmpt, 'T' ) IF (ISCOMP(input,'1234567890qwertyuiop') .ne. 0 ) THEN flg = Ynquery('Did you enter the line correctly? \') IF (flg .eq. .FALSE.) Goto 5 Call MtFail( 'inputc', 1 ) Call WriteString( '1234567890', 0, 10 ) Call WriteString( input(1:10), 0, 10 ) Call WriteLn UiGtLin = UiGtlin + 2**1 END IF Call TestFail( UIgtlin ) Call CentLn( '--- Testing GTLIN completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C----------------------------------- ICSI ------------------------------------ Function UIICSI Integer*4 UIICSI Integer*4 TstFIcsi Integer*2 res, spec(39), deftype(4), option(4,4) Character*50 str Character*12 Filen Logical*2 Flg, Ynquery Call CentLn( '--- Testing ICSI ---\' ) Call CentLn( 'Decodes file specification options\') UIICSI = 0 option(1,1) = Ichar( 'A' ) option(1,2) = Ichar( 'B' ) option(1,3) = Ichar( 'C' ) option(1,4) = Ichar( 'D' ) Call Irad50( 3, 'TST', deftype(1) ) Call Irad50( 3, 'TST', deftype(2) ) Call Irad50( 3, 'DAT', deftype(3) ) Call Irad50( 3, 'LST', deftype(4) ) 10 Call WriteLn Call CentLn('Please type the following line of text:\') Call WriteString( '*FILE=FILE\' ,0 ,0 ) Call WriteLn res = Icsi( spec, deftype,, option, 4 ) Call WriteLn flg = Ynquery('Did you enter the line correctly? \') IF (flg .eq. .FALSE.) Goto 10 IF (res .ne. 0) THEN Call MtFail( 'normal', 1 ) Call Write2Int( 0, 10 ) Call Write2Int( res, 10 ) Call WriteLn Uiicsi = Uiicsi + 2**1 END IF 20 Call WriteLn Call CentLn('Please type the following line of text:\') Call WriteString( '*DK:FILE/A:2/B=WERT/C:6/D \',0,0) Call WriteLn res = Icsi( spec, deftype,, option, 4 ) Call WriteLn flg = Ynquery('Did you enter the line correctly? \') IF (flg .eq. .FALSE.) Goto 20 IF (res .ne. 0) THEN Call Mtfail( 'normal', 2 ) Call Write2Int( 0, 10 ) Call Write2Int( res, 10 ) Call WriteLn Uiicsi = Uiicsi + 2**2 END IF IF (option(2,1) .ne. 2) THEN Call Mtfail( 'optprs', 3 ) Call Write2Int( 2, 10 ) Call Write2Int( option(2,1), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**3 END IF IF (option(3,1) .ne. 0) THEN Call Mtfail( 'filnum', 4 ) Call Write2Int( 0, 10 ) Call Write2Int( option(3,1), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**4 END IF IF (option(4,1) .ne. 2) THEN Call Mtfail( 'optval', 5 ) Call Write2Int( 2, 10 ) Call Write2Int( option(4,1), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**5 END IF IF (option(2,2) .ne. 1) THEN Call Mtfail( 'optprs', 6 ) Call Write2Int( 1, 10 ) Call Write2Int( option(2,2), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**6 END IF IF (option(3,2) .ne. 0) THEN Call Mtfail( 'filnum', 7 ) Call Write2Int( 0, 10 ) Call Write2Int( option(3,2), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**7 END IF IF (option(2,3) .ne. 2) THEN Call Mtfail( 'optprs', 8 ) Call Write2Int( 2, 10 ) Call Write2Int( option(2,3), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**8 END IF IF (option(3,3) .ne. 3) THEN Call Mtfail( 'filnum', 9 ) Call Write2Int( 3, 10 ) Call Write2Int( option(3,3), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**9 END IF IF (option(2,4) .ne. 1) THEN Call Mtfail( 'optprs', 10 ) Call Write2Int( 1, 10 ) Call Write2Int( option(2,4), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**10 END IF IF (option(3,4) .ne. 3) THEN Call Mtfail( 'filnum', 11 ) Call Write2Int( 3, 10 ) Call Write2Int( option(3,4), 10 ) Call WriteLn Uiicsi = Uiicsi + 2**11 END IF Call R50asc( 12, Spec(1), filen ) IF (filen .ne. 'DK FILE TST') THEN Call Mtfail( 'filenm', 12 ) Call WriteString( 'DK FILE TST', 0, 10 ) Call WriteString( filen, 0, 10 ) Call WriteLn Uiicsi = Uiicsi + 2**12 END IF Call R50asc( 12, Spec(16), filen ) IF (filen .ne. 'DK WERT TST') THEN Call Mtfail( 'filenm', 13 ) Call WriteString( 'DK FILE TST', 0, 10 ) Call WriteString( filen, 0, 10 ) Call WriteLn Uiicsi = Uiicsi + 2**13 END IF Call TestFail( UIICSI ) Call CentLn( '--- Testing ICSI completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C----------------------------------- ITTINR ---------------------------------- Function UIITTINR Integer*4 UIIttinr Character*21 cmp Byte inp(21) Integer*2 cnt, i, i2, test Integer*2 BEEP, BS, LF, CR, CTRLU, BLANK, RUBOUT Logical*2 flg, YnQuery Integer*2 JSW, BFbit, Bit6, Bit12 Data CTRLU / "25 /, RUBOUT / "177 /, BLANK / "40 / Data BEEP / "7 /, BS / "10 /, LF / "12 /, CR / "15 / DATA JSW /"44/ DATA Bit6 /"100/, Bit12 / "10000 / Call CentLn( '--- Testing ITTINR ---\' ) Call CentLn( 'Inputs a character from the console.\') UIittinr = 0 JSWSAV = IPEEK( JSW) C C Do two tests; the first with JSW Bit12 Clear (wait mode), and C the second with it set (no-wait immediate return mode). C Do 100 test=1,2 10 Call WriteLn if (test .eq. 1) then Call CentLn('NORMAL I/O Mode\') CALL IPOKE(JSW, JSWSAV .OR. Bit6) else Call CentLn('SPECIAL I/O Mode\') CALL IPOKE(JSW, JSWSAV .OR. (Bit12+Bit6)) endif Call WriteLn Call CentLn('Please type the following line of text:\') Call WriteString( ':> 1234567890qwertyuiop\' ,0 ,0 ) Call WriteLn cmp = '1234567890qwertyuiop' Call Settrm( cmp, 21 ) Call WriteString( ':> \', 0, 0 ) i = 1 ! simulate DO loop 20 if (i .gt. 21) go to 50 ! exit loop? 30 i2 = Ittinr() ! wait for a character... if (i2 .lt. 0) go to 30 ! tight loop... if (i2 .eq. CR) go to 50 ! ? if (i2 .eq. RUBOUT .or. i2 .eq. CTRLU) then ! DELETE? 40 if (i .gt. 1) then call ITTOUR( BS) ! Backspace, call ITTOUR( BLANK) ! Blank, call ITTOUR( BS) ! Backspace, i = i - 1 ! backup pointer if (i2 .eq. CTRLU) go to 40 else call ITTOUR( BEEP) ! indicate no more to delete endif go to 30 endif if (i2 .lt. BLANK) i2 = '$' ! Convert ctrl-chars to '$' if (i .lt. 21) then if (test .eq. 2) call ITTOUR( i2) ! Echo character inp(i) = i2 ! store it i = i + 1 else if (test .eq. 2) then call ITTOUR( BEEP) endif endif go to 20 ! loop for more C Line is complete. 50 if (test .eq. 2) then call ITTOUR( CR) call ITTOUR( LF) endif i2 = Ittinr() ! Eat the Line-Feed inp(21) = 0 CALL IPOKE(JSW, JSWSAV) ! Restore JSW IF (ISCOMP( inp, cmp ) .ne. 0) THEN flg = Ynquery('Did you enter the line correctly? \') IF (flg .eq. .FALSE.) Goto 10 Call MtFail( 'inputc', 1 ) Call WriteString( '1234567890', 0, 10 ) Call WriteString( inp, 0, 10 ) Call WriteLn UiIttinr = UiIttinr + 2**1 ELSE Call CentLn('-- Success --\') END IF 100 Continue ! next test or drop through Call TestFail( UIIttinr ) Call CentLn( '--- Testing ITTINR completed ---\' ) Call WriteLn END C----------------------------------- ITTOUR ---------------------------------- Function UIITTOUR Integer*4 UIittour Character*45 out Integer*2 i Call CentLn( '--- Testing ITTOUR ---\' ) Call CentLn( 'Sends a character to the console\') UIIttour = 0 out = 'The following line should read as the first.' Call settrm( out, 44 ) Call WriteString( ' \', 0, 0 ) Call Print( out ) Call WriteString( ' \', 0, 0 ) Do 10 i = 1, 43 Call Ittour( out(i:i) ) 10 Continue Call WriteLn Call TestFail( UIIttour ) Call CentLn( '--- Testing ITTOUR completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C----------------------------------- MTIN ------------------------------------ Function UIMtin Integer*4 UIMtin Character*80 a Character*21 cmp Byte inp(21), a1(40) Character*1 ch Integer*2 cnt, i, Stts(8), res Logical*2 flg, Mtquery, MTTY Equivalence (a,a1(1)) Call CentLn( '--- Testing MTIN ---\' ) Call CentLn( 'Inputs a character from terminal \') UIMtin = 0 IF ( .NOT. MTTY()) THEN Call CentLn('-==============================-\') Call CentLn('No MultiTerminal Support Present\') Call CentLn('-==============================-\') Call WriteLn Goto 999 END IF Call MtStat( Stts ) DO 100 j = 0, stts(3) res = MtAtch( j ) IF (res .ge. 3) Goto 100 Call MtPrnt( j, ' ' ) a = 'Logical terminal number: ' Call Substr( '0123456789ABCDEF', a1(26), J+1 ) a1(27) = 0 Call MtPrnt( j, a ) Call MtPrnt( j, ' ' ) 5 Call Concat( ' ',"200, a ) Call MtPrnt( j, a ) Call MtPrnt( j, 'Type the following characters :' ) Call MtPrnt( j, ':> 1234567890qwertyuiop' ) cmp = '1234567890qwertyuiop' Call Settrm( cmp, 21 ) Call Concat( ':> ', "200, a ) Call MtPrnt( j, a ) DO 10 i = 1, 21 res = MtIn(j,inp(i),1) IF (res .ne. 0) THEN Call MtFail( 'mtinrs', 1 ) Call Write2Int( 0, 10 ) Call Write2Int( res, 10 ) Call WriteLn UiMtin = 2**1 END IF 10 Continue res = MtIn(j,Inp(21),1) inp(21) = 0 IF (ISCOMP( inp, cmp ) .ne. 0) THEN flg = Mtquery(j,'Did you enter the line correctly? \') IF (flg .eq. .FALSE.) Goto 5 Call MtFail( 'inputc', 2 ) Call WriteString( '1234567890', 0, 10 ) Call WriteString( inp, 0, 10 ) Call WriteLn Uimtin = Uimtin + 2**2 END IF Call MtPrnt( j, ' ' ) 20 Call Concat( ' ',"200, a ) Call MtPrnt( j, a ) Call MtPrnt( j, 'Type the following characters :' ) Call MtPrnt( j, ':> 1234567890qwertyuiop' ) cmp = '1234567890qwertyuiop' Call Settrm( cmp, 21 ) Call Concat( ':> ', "200, a ) Call MtPrnt( j, a ) res = MtIn(j,inp,21) IF (res .ne. 0) THEN Call MtFail( 'mtinrs', 3 ) Call Write2Int( 0, 10 ) Call Write2Int( res, 10 ) Call WriteLn UiMtin = UiMtin + 2**3 END IF res = MtIn(j,inp(21),1) inp(21) = 0 IF (ISCOMP( inp, cmp ) .ne. 0) THEN flg = Mtquery(j,'Did you enter the line correctly? \') IF (flg .eq. .FALSE.) Goto 20 Call MtFail( 'inputc', 4 ) Call WriteString( '1234567890', 0, 10 ) Call WriteString( inp, 0, 10 ) Call WriteLn Uimtin = Uimtin + 2**4 END IF 100 Continue 999 Call TestFail( UIMtin ) Call CentLn( '--- Testing MTIN completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C----------------------------------- MTOUT ---------------------------------- Function UIMTout Integer*4 UIMtout Integer*2 Stts(8), res, i, j Character*45 a, b Byte a1(45) Logical*2 MTTY Equivalence (a, a1(1)) Call CentLn( '--- Testing MTOUT ---\' ) Call CentLn( 'Outputs a character to terminal \') UIMtout = 0 IF ( .NOT. MTTY()) THEN Call CentLn('-==============================-\') Call CentLn('No MultiTerminal Support Present\') Call CentLn('-==============================-\') Goto 999 END IF Call MtStat( Stts ) DO 20 j = 0, stts(3) res = MtAtch( j ) IF (res .ge. 3) Goto 20 Call MtPrnt( j, ' ' ) a = 'Logical terminal number: ' Call Substr( '0123456789ABCDEF',a1(26),J+1 ) a1(27) = 0 Call MtPrnt( j, a ) Call MtPrnt( j, ' ' ) a = 'The following line should read as the first.' Call settrm( a, 44 ) Call Concat( ' ', "200, b ) Call MtPrnt( j, b ) Call MtPrnt( j, a ) Call MtPrnt( j, b ) Do 10 i = 1, 43 Call Mtout( j, a(i:i) ) 10 Continue Call MtPrnt( j, ' ' ) Call MtPrnt( j, b ) Call MtOut( j, a, 43 ) Do 15 i = 1, 4 Call Mtout( j, 7 ) 15 Continue Call MtPrnt( j, ' ' ) 20 Continue 999 Call TestFail( UIMtout ) Call CentLn( '--- Testing MTOUT completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C---------------------------------- MTPRINT ---------------------------------- Function UIMtprint Integer*4 UIMtprint Integer*2 Stts(8), res, i Character*80 a,b Byte a1(40) Logical*2 MTTY Equivalence (a, a1(1)) Call CentLn( '--- Testing MTPRINT ---\' ) Call CentLn( 'Outputs a string to terminal \') UIMtprint = 0 IF ( .NOT. MTTY()) THEN Call CentLn('-==============================-\') Call CentLn('No MultiTerminal Support Present\') Call CentLn('-==============================-\') Goto 999 END IF Call MtStat( Stts ) DO 10 i = 0, stts(3) res = MtAtch( i ) IF (res .ge. 3) Goto 10 Call MtPrnt( i, ' ' ) a = 'Logical terminal number: ' Call Substr( '0123456789ABCDEF', a1(26), i+1 ) a1(27) = 0 Call MtPrnt( i, a ) Call MtPrnt( i, ' ' ) a = 'There should be no space between these lines' Call Settrm( a, 45 ) res = res + MtPrnt( i, a ) res = res + MtPrnt( i, a ) Call concat( 'This should all be', "200, a ) Call concat( ' on the same line when printed.', "0, b ) res = res + MtPrnt( i, a ) res = res + MtPrnt( i, b ) IF (res .gt. 12) THEN Call MtFail('mtprnt', 1 ) Call Write2Int( 0, 10 ) Call Write2Int( res, 10 ) Call WriteLn UIMtprint = UIMtprint + 2**1 Goto 999 END IF 10 Continue 999 Call TestFail( UIMtprint ) Call CentLn( '--- Testing MTPRINT completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C----------------------------------- PRINT ----------------------------------- Function UIPrint Integer*4 UIPrint Character*50 a,b Call CentLn( '--- Testing PRINT ---\' ) Call CentLn( 'Outputs a string to the console\') UIprint = 0 Call WriteLn Call WriteString('|----------------------------------|\',0,0) Call WriteLn Call Print( ' This line should fall in the lines' ) Call Print( ' This line should fall in the lines' ) Call WriteString('|----------------------------------|\',0,0) Call WriteLn a = 'There should be no space between these lines' Call Settrm( a, 45 ) Call Print( a ) Call Print( a ) Call concat( 'This should all be', "200, a ) Call concat( ' on the same line when printed.', "0, b ) Call Print( a ) Call Print( b ) Call WriteString( 'There should be no stray characters.\',0,0 ) Call WriteLn Call WriteLn Call TestFail( UIprint ) Call CentLn( '--- Testing PRINT completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C---------------------------------- MtRCTO ----------------------------------- Function UIMtRcto Integer*4 UIMtRcto Integer*2 res, i, j, k, stts(8) Character*3 ch Logical*2 l, Mtquery, MTTY Character*80 a Byte a1(40), Bell(4) Equivalence (a,a1(1)) Call CentLn( '--- Testing MTRCTO ---\' ) Call CentLn('Undoes a CTRL/O from the terminal\') Call WriteLn Call CentLn('Please press a CTRL/O on the Specified unit\') Call CentLn('The CTRL/O should not permenantly stop output\') UIMtRcto = 0 IF ( .NOT. MTTY()) THEN Call CentLn('-==============================-\') Call CentLn('No MultiTerminal Support Present\') Call CentLn('-==============================-\') Goto 999 END IF Call MtStat( Stts ) DO 100 k = 0, stts(3) res = MtAtch( k ) IF (res .ge. 3) Goto 100 bell(1) = 7 bell(2) = 7 bell(3) = 7 bell(4) = 0 Call MtPrnt( k, bell ) a = 'Logical terminal number: ' Call Substr( '0123456789ABCDEF', a1(26), k+1 ) a1(27) = 0 Call MtPrnt( k, a ) Call MtPrnt( k, ' ' ) l=Mtquery(k,'Press Return when ready to press a CTRL/O\') Call concat( 'X', "200, ch, 2 ) DO 10 i = 1, 25 DO 5 j = 1, 79 Call MtRCtO( k ) Call MtPrnt( k, ch ) 5 Continue Call MtPrnt( k, ' ' ) 10 Continue 100 Continue 999 Call TestFail( UIMtRcto ) Call CentLn( '--- Testing MTRCTO completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C---------------------------------- RCTRLO ----------------------------------- Function UIRctrlo Integer*4 UIRctrlo Integer*2 i, j Character*3 ch Call CentLn( '--- Testing RCTRLO ---\' ) Call CentLn( 'Undoes a CTRL/O from the terminal\') UIRctrlo = 0 Call WriteLn Call CentLn('Please press a CTRL/O on the console terminal\') Call CentLn('The CTRL/O should not permenantly stop output\') Call WriteLn Call Query('Press when ready \') Call concat( 'X', "200, ch, 2 ) DO 10 i = 1, 25 DO 5 j = 1, 79 Call RCtrlO Call Print( ch ) 5 Continue Call Print( ' ' ) 10 Continue Call TestFail( UIRctrlo ) Call CentLn( '--- Testing RCTRLO completed ---\' ) Call WriteLn END C----------------------------------------------------------------------------- C----------------------------------- SCCA ------------------------------------ C C UISCCA --- TEST PROGRAM FOR SCCA SYSLIB TEST ROUTINE. C C C Author: Ibiyekaribo B. Sokari C Date: February 1988 C Last Edited: July 1988 C Language: Fortran 77 C C ======= TEST PLAN ======= C C The test program will test each of the five functionalities of C SCCA syslib routine. It will involve interactions with the C user at the console while the different functionalities are C being tested. C Specifically, the program will accomplish the following: C C (1) indicate when a CTRL/C is active --- typed from the console C (2) identify between a single CTRL/C and two consecutive C CTRL/C --- CALL SCCA(iflag) test. C (3) disable local CTRL/C abort --- C --- CALL SCCA(iflag,itype=LOCAL) test C (4) disable global CTRL/C abort --- C --- CALL SCCA(iflag,itype=GLOBAL) test C (5) enable local CTRL/C abort --- CALL SCCA(,itype=LOCAL) test C (6) enable global CTRL/C abort --- CALL SCCA(,itype=GLOBAL) test C (7) disable a CTRL/C intercept --- CALL SCCA test C C Since disabling a CTRL/C intercept will also enable C CTRL/C abort, the seventh test will, in essence, be testing C two functionalities. C C When CTRL/C intercept is disabled or global and local CTRL/C C abort are enabled, the user can exit the test program by typing C a CTRL/C. C C (i) For a successful test, SL should be SET OFF before running C the test program. C C (ii) The SCCA/ISCCA test must be run on a SYSGENED monitor for C GLOBAL SCCA/ISCCA to work. C C============================================================================= C C ----------------- FUNCTION UISCCA ----------------- C Function UISCCA C C ------- Program Declarations ------- Integer*4 UISCCA Integer*2 I, IFLAG, ITYPE, CNT, JJ Integer*2 LOCAL, LFLAG Integer*2 GLOBAL, GFLAG Integer*2 TFLAG, SFLAG Character*1 inp Integer*2 CONFIG2, SCCABIT C C ------- Program Initializations ------- DATA CONFIG2 /"370/ DATA SCCABIT /"10000/ IFLAG = 0 ! Default TFLAG = 0 ! Flag to indicate ! user has specified ! itype param. GFLAG = 0 ! Flag to indicate ! ITYPE = GLOBAL LOCAL = 0 ! Disable local ! CTRL/C abort. GLOBAL = 1 ! Disable global ! CTRL/C abort. CNT = 0 ITYPE = LOCAL ! Default UISCCA = 0 C C ======= MAIN PROGRAM CODE ======= C Call CentLn ( '--- Testing SCCA ---\') Call WriteLn C Test various functionalities of the SCCA routine C C Testing CALL SCCA(IFLAG) --- distinquishes between a C single CTRL/C and consecutive double C CTRL/C C Call CentLn (' --- Distinguish between a SINGLE CTRL/C 1 and TWO consecutive CTRL/C''s ---\') Call WriteLn Call WriteLn C Call SCCA(IFLAG) 10 IFLAG = 0 Call WriteLn Call CentLn (' Please type a CTRL/C \') 20 I = ITTINR() ! Get a character IF (I .NE. 3) THEN ! Keep looping until a ctrl/c is typed GOTO 20 END IF IF (CNT .EQ. 0 ) THEN IFLAG = 0 END IF IF (IFLAG .EQ. 0) THEN Call CentLn (' A CTRL/C was typed \') ! No second consecutive ctrl/c ! Keep looping until the second one Call CentLn (' Type another CTRL/C to continue testing \') CNT = 1 GOTO 20 ELSE SFLAG = 1 Call CentLn (' A second consecutive CTRL/C was typed \') Call WriteLn END IF C IF (LFLAG .EQ. 0 .AND. GFLAG .EQ. 0) THEN ! Not testing ! combination ! of parameters. Call TestFail( UISCCA ) Call CentLn (' --- Testing CALL SCCA(IFLAG) completed ---\') Call WriteLn ELSE GOTO 30 ! Go and test ITYPE functionality END IF C C Testing CALL SCCA(IFLAG,ITYPE = LOCAL) --- Disable LOCAL C CTRL/C abort IF (LFLAG .EQ. 0 ) THEN Call CentLn (' --- Testing DISABLE LOCAL ctrl/c abort --- \') C IFLAG = 0 ITYPE = LOCAL CALL SCCA(IFLAG,ITYPE) LFLAG = 1 CNT = 0 GOTO 10 ! Test IFLAG parameter END IF 30 IF ( TFLAG .EQ. 0 ) THEN ! Test ITYPE parameter Call WriteLn Call CentLn(' Type a CTRL/C to test if LOCAL CTRL/C 1 abort is disabled\') 40 I = ITTINR() IF ( I .NE. 3 ) THEN GOTO 40 ELSE Call Isleep(0,0,5,0) Call TestFail( UISCCA ) Call CentLn(' --- Testing DISABLE LOCAL CTRL/C abort 1 completed ---\') TFLAG = 1 END IF END IF C C Check if monitor is sysgened for Global SCCA support. C J = ISPY(CONFIG2) IF (( J .AND. SCCABIT ) .NE. 0 ) THEN C C There is Global SCCA support C IF ( GFLAG .EQ. 0 ) THEN C C Testing CALL SCCA(IFLAG,ITYPE = GLOBAL) --- Disable global C CTRL/C abort Call WriteLn Call CentLn (' --- Testing DISABLE GLOBAL ctrl/c abort ---\') ITYPE = GLOBAL GFLAG = 1 CALL SCCA(IFLAG,ITYPE) ! Disable global CTRL/C abort CNT = 0 GOTO 10 ! Test IFLAG parameter ELSE ! Test Itype parameter Call WriteLn Call CentLn (' Type a CTRL/C to test if GLOBAL CTRL/C abort 1 is disabled\') 60 I = ITTINR() IF ( I .NE. 3 ) THEN GOTO 60 ! Prompt for CTRL/C again ELSE Call Isleep(0,0,5,0) Call TestFail( UISCCA ) Call CentLn (' --- Testing DISABLE GLOBAL CTRL/C abort 1 completed\') END IF END IF ELSE Call Isleep(0,0,5,0) Call WriteLn Call WriteLn Call CentLn(' ?SCCA-I-Global SCCA test not performed \') Call CentLn(' Monitor not sysgened to support Global SCCA \') Call WriteLn Call Isleep(0,0,5,0) END IF C C Test CALL SCCA(,ITYPE=LOCAL) --- Enable LOCAL CTRL/C abort C Call CentLn(' --- ENABLING LOCAL CTRL/C abort ---\') ITYPE = LOCAL CALL SCCA(,ITYPE) Call CentLn (' --- LOCAL CTRL/C abort now ENABLED ---\') Call WriteLn C C Check if monitor is sysgened for Global SCCA support. C IF (( J .AND. SCCABIT ) .NE. 0 ) THEN C C There is Global SCCA support C C C Test CALL SCCA(,ITYPE=GLOBAL) --- Enable GLOBAL CTRL/C abort C Call CentLn(' --- ENABLING GLOBAL CTRL/C abort --- \') Call WriteLn ITYPE = GLOBAL CALL SCCA(,ITYPE) C Call CentLn(' --- GLOBAL CTRL/C abort now ENABLED ---\') Call WriteLn END IF c Call CentLn (' --- Testing CALL SCCA (Disable CTRL/C c 1 intercept) ---\') c Call WriteLn CALL SCCA Call WriteLn Call TestFail( UISCCA ) Call CentLn (' --- Testing SCCA completed ---\') Call WriteLn END C---------------------------------- ISCCA ------------------------------------ C C UIISCCA --- TEST PROGRAM FOR THE ISCCA SYSLIB TEST ROUTINE. C C C Author: Ibiyekaribo B. Sokari C Date: February 1988 C Last Edited: July 1988 C Language: Fortran 77 C C ======= TEST PLAN ======= C C The test program will test each of the five functionalities of C ISCCA syslib routine. It will involve interactions with the C user at the console while the different functionalities are C being tested. C Specifically, the program will accomplish the following: C C (1) indicate when a CTRL/C is active --- typed from the console C (2) identify between a single CTRL/C and two consecutive C CTRL/C --- I = ISCCA(iflag) test. C (3) disable local CTRL/C abort --- C --- I = ISCCA(iflag,itype=LOCAL) test C (4) disable global CTRL/C abort --- C --- I = ISCCA(iflag,itype=GLOBAL) test C (5) enable local CTRL/C abort --- I = ISCCA(,itype=LOCAL) test C (6) enable global CTRL/C abort --- I = ISCCA(,itype=GLOBAL) test C (7) disable a CTRL/C intercept --- I = ISCCA() test C C Tests (2) thru (6) will, in addition to testing a C parameter/parameters, also return an integer value that C indicates if there was a previous SCCA command or not. C C Since disabling a CTRL/C intercept will also enable C CTRL/C abort, the seventh test will, in essence, be testing C two functionalities. C C When CTRL/C intercept is disabled or global and local CTRL/C C abort are enabled, the user can exit the test program by typing C a CTRL/C. C C (i) For a successful test, SL should be SET OFF before running C the test program. C C (ii) The SCCA/ISCCA test must be run on a SYSGENED monitor for C GLOBAL SCCA/ISCCA to work. C C============================================================================= C C ----------------- FUNCTION UIISCCA ----------------- C Function UIISCCA C C ------- Program Declarations ------- Integer*4 UIISCCA Integer*2 I, IFLAG, ITYPE, CNT, RES Integer*2 LOCAL, LFLAG Integer*2 GLOBAL, GFLAG Integer*2 TFLAG, SFLAG Character*1 inp Integer*2 CONFIG2, SCCABIT External sccinfo C C ------- Program Initializations ------- DATA CONFIG2 /"370/ DATA SCCABIT /"10000/ IFLAG = 0 ! Default TFLAG = 0 ! Flag to indicate ! user has specified ! itype param. GFLAG = 0 ! Flag to indicate ! ITYPE = GLOBAL LOCAL = 0 ! Disable local ! CTRL/C abort. GLOBAL = 1 ! Disable global ! CTRL/C abort. CNT = 0 RES = 0 ITYPE = LOCAL ! Default UIISCCA = 0 C C ======= MAIN PROGRAM CODE ======= C Call CentLn ( '--- Testing ISCCA ---\') Call WriteLn C Test various functionalities of the ISCCA routine C C Testing I = ISCCA(IFLAG) --- distinguishes between a C single CTRL/C and consecutive double C CTRL/C C Call CentLn (' --- Distinguish between a SINGLE CTRL/C 1 and TWO consecutive CTRL/C''s ---\') Call WriteLn RES = ISCCA(IFLAG) 10 IFLAG = 0 Call WriteLn Call CentLn (' Please type a CTRL/C \') 20 I = ITTINR() ! Get a character IF (I .NE. 3) THEN ! Keep looping until a CTRL/C is typed GOTO 20 END IF IF (CNT .EQ. 0 ) THEN IFLAG = 0 END IF IF (IFLAG .EQ. 0) THEN Call CentLn (' A CTRL/C was typed \') ! No second consecutive CTRL/C ! Keep looping until the second one Call CentLn (' Type another CTRL/C to continue testing \') CNT = 1 GOTO 20 ELSE SFLAG = 1 Call CentLn (' A second consecutive CTRL/C was typed \') Call WriteLn END IF C IF (LFLAG .EQ. 0 .AND. GFLAG .EQ. 0) THEN ! Not testing ! combination ! of parameters. Call Sccinfo( RES ) Call TestFail( UIISCCA ) Call CentLn (' --- Testing I = ISCCA(IFLAG) completed ---\') Call WriteLn ELSE GOTO 30 ! Go and test ITYPE functionality END IF C C Testing I = ISCCA(IFLAG,ITYPE = LOCAL) --- Disable LOCAL C CTRL/C abort IF (LFLAG .EQ. 0 ) THEN Call CentLn (' --- Testing DISABLE LOCAL CTRL/C abort --- \') Call WriteLn C IFLAG = 0 ITYPE = LOCAL RES = 0 RES = ISCCA(IFLAG,ITYPE) LFLAG = 1 CNT = 0 GOTO 10 ! Test IFLAG parameter END IF 30 IF ( TFLAG .EQ. 0 ) THEN ! Test ITYPE parameter Call CentLn(' Type a CTRL/C to test if LOCAL CTRL/C 1 abort is disabled\') 40 I = ITTINR() IF ( I .NE. 3 ) THEN GOTO 40 ELSE Call Isleep(0,0,5,0) Call Sccinfo( RES ) Call TestFail( UIISCCA ) Call CentLn(' --- Testing DISABLE LOCAL CTRL/C abort 1 completed ---\') Call WriteLn TFLAG = 1 END IF END IF C C Check if monitor is sysgened for Global SCCA support. C J = ISPY(CONFIG2) IF (( J .AND. SCCABIT ) .NE. 0 ) THEN C C There is Global SCCA support C IF ( GFLAG .EQ. 0 ) THEN C C Testing I = ISCCA(IFLAG,ITYPE = GLOBAL) --- Disable global C CTRL/C abort Call WriteLn Call CentLn (' --- Testing DISABLE GLOBAL CTRL/C abort ---\') ITYPE = GLOBAL GFLAG = 1 RES = 0 RES = ISCCA(IFLAG,ITYPE) ! Disable global CTRL/C abort CNT = 0 GOTO 10 ! Test IFLAG parameter ELSE ! Test Itype parameter Call CentLn (' Type a CTRL/C to test if GLOBAL CTRL/C abort 1 is disabled\') 60 I = ITTINR() IF ( I .NE. 3 ) THEN GOTO 60 ! Prompt for CTRL/C again ELSE Call Isleep(0,0,5,0) Call Sccinfo( RES ) Call TestFail( UIISCCA ) Call CentLn (' --- Testing DISABLE GLOBAL CTRL/C abort 1 completed ---\') END IF END IF ELSE Call Isleep(0,0,5,0) Call WriteLn Call WriteLn Call CentLn(' ?ISCCA-I-Global SCCA test not performed \') Call CentLn(' Monitor not sysgened to support Global SCCA \') Call Isleep(0,0,5,0) END IF C C Test I = ISCCA(,ITYPE=LOCAL) --- Enable LOCAL CTRL/C abort C Call WriteLn Call CentLn(' --- ENABLING LOCAL CTRL/C abort ---\') ITYPE = LOCAL RES = 0 RES = ISCCA(,ITYPE) Call CentLn (' --- LOCAL CTRL/C abort now ENABLED ---\') Call WriteLn C C Check if monitor is sysgened for Global SCCA support. C IF (( J .AND. SCCABIT ) .NE. 0 ) THEN C C There is Global SCCA support C C C Test I = ISCCA(,ITYPE=GLOBAL) --- Enable GLOBAL CTRL/C abort C Call CentLn(' --- Enabling GLOBAL CTRL/C abort --- \') Call WriteLn ITYPE = GLOBAL RES = 0 RES = ISCCA(,ITYPE) Call CentLn(' --- GLOBAL CTRL/C abort now ENABLED ---\') Call WriteLn END IF c Call CentLn (' --- Testing I = ISCCA() (Disable CTRL/C c 1 intercept) ---\') c Call WriteLn RES = 0 RES = ISCCA() Call WriteLn Call TestFail( UIISCCA ) Call CentLn (' --- Testing ISCCA completed ---\') Call WriteLn END C================================== Sccinfo ================================ Subroutine Sccinfo( result ) Integer*2 result IF ( result .EQ. 0 ) THEN Call CentLn(' NO previous SCCA command \') ELSE Call CentLn(' There was a previous SCCA command \') END IF RETURN END