2004-09-22 03:43:39 -04:00
|
|
|
;;; Test for the function in section 3.12 of the scsh-manual "Terminal device control"
|
|
|
|
|
;;; Author: Christoph Hetz
|
|
|
|
|
|
|
|
|
|
;; for testing: (certainly the path will be an other on other systems...)
|
|
|
|
|
|
|
|
|
|
;; ,open define-record-types handle
|
|
|
|
|
;; ,config ,load C:/cygwin/home/mephisto/cvs-scsh/scsh/scsh/test/test-packages.scm
|
|
|
|
|
;; ,load C:/cygwin/home/mephisto/cvs-scsh/scsh/scsh/test/test-base.scm
|
|
|
|
|
;; load this file
|
|
|
|
|
;; (test-all)
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-test 'terminal-devive-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((ti (tty-info)))
|
|
|
|
|
(and (string? (tty-info:control-chars ti))
|
|
|
|
|
(or (integer? (tty-info:input-flags ti))
|
|
|
|
|
(not (tty-info:input-flags ti)))
|
|
|
|
|
(or (integer? (tty-info:output-flags ti))
|
|
|
|
|
(not (tty-info:output-flags ti)))
|
|
|
|
|
(or (integer? (tty-info:control-flags ti))
|
|
|
|
|
(not (tty-info:control-flags ti)))
|
|
|
|
|
(or (integer? (tty-info:local-flags ti))
|
|
|
|
|
(not (tty-info:local-flags ti)))
|
2006-03-29 08:37:58 -05:00
|
|
|
(or (or (integer? (tty-info:input-speed ti))
|
|
|
|
|
(memq (tty-info:input-speed ti) '(exta extb)))
|
2004-09-22 03:43:39 -04:00
|
|
|
(not (tty-info:input-speed ti)))
|
2006-03-29 08:37:58 -05:00
|
|
|
(or (or (integer? (tty-info:output-speed ti))
|
|
|
|
|
(memq (tty-info:output-speed ti) '(exta extb)))
|
2004-09-22 03:43:39 -04:00
|
|
|
(not (tty-info:output-speed ti)))
|
|
|
|
|
(or (integer? (tty-info:min ti))
|
|
|
|
|
(not (tty-info:min ti)))
|
|
|
|
|
(or (integer? (tty-info:time ti))
|
|
|
|
|
(not(tty-info:time ti)))))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'make-tty-info-test 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let* ((in-fl 770)
|
|
|
|
|
(out-fl 3)
|
|
|
|
|
(c-fl 19200)
|
|
|
|
|
(loc-fl 1482)
|
|
|
|
|
(in-spd 1200)
|
|
|
|
|
(out-spd 1200)
|
|
|
|
|
(min 1)
|
|
|
|
|
(time 0)
|
|
|
|
|
(ti (make-tty-info in-fl
|
|
|
|
|
out-fl
|
|
|
|
|
c-fl
|
|
|
|
|
loc-fl
|
|
|
|
|
in-spd
|
|
|
|
|
out-spd
|
|
|
|
|
min
|
|
|
|
|
time)))
|
|
|
|
|
(and (= in-fl
|
|
|
|
|
(tty-info:input-flags ti))
|
|
|
|
|
(= out-fl
|
|
|
|
|
(tty-info:output-flags ti))
|
|
|
|
|
(= c-fl
|
|
|
|
|
(tty-info:control-flags ti))
|
|
|
|
|
(= in-spd
|
|
|
|
|
(tty-info:input-speed ti))
|
|
|
|
|
(= out-spd
|
|
|
|
|
(tty-info:output-speed ti))
|
|
|
|
|
(= min
|
|
|
|
|
(tty-info:min ti))
|
|
|
|
|
(= time
|
|
|
|
|
(tty-info:time ti))))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'copy-tty-test 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let* ((ti (tty-info))
|
|
|
|
|
(ti-c (copy-tty-info ti)))
|
|
|
|
|
(and (tty-info? ti)
|
|
|
|
|
(tty-info? ti-c)
|
|
|
|
|
(equal? (tty-info:control-chars ti)
|
|
|
|
|
(tty-info:control-chars ti-c))
|
|
|
|
|
(= (tty-info:input-flags ti)
|
|
|
|
|
(tty-info:input-flags ti-c))
|
|
|
|
|
(= (tty-info:output-flags ti)
|
|
|
|
|
(tty-info:output-flags ti-c))
|
|
|
|
|
(= (tty-info:control-flags ti)
|
|
|
|
|
(tty-info:control-flags ti-c))
|
|
|
|
|
(= (tty-info:local-flags ti)
|
|
|
|
|
(tty-info:local-flags ti-c))
|
|
|
|
|
(equal? (tty-info:input-speed ti)
|
|
|
|
|
(tty-info:input-speed ti-c))
|
|
|
|
|
(equal? (tty-info:output-speed ti)
|
|
|
|
|
(tty-info:output-speed ti-c))
|
|
|
|
|
(= (tty-info:min ti)
|
|
|
|
|
(tty-info:min ti-c))
|
|
|
|
|
(= (tty-info:time ti)
|
|
|
|
|
(tty-info:time ti-c))))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-posix-indicies-test 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(and ttychar/delete-char
|
|
|
|
|
ttychar/delete-line
|
|
|
|
|
ttychar/eof
|
|
|
|
|
ttychar/eol
|
|
|
|
|
ttychar/interrupt
|
|
|
|
|
ttychar/quit
|
|
|
|
|
ttychar/suspend
|
|
|
|
|
ttychar/start
|
|
|
|
|
ttychar/stop)))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-posix-input-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(and ttyin/check-parity
|
|
|
|
|
ttyin/ignore-bad-parity-chars
|
|
|
|
|
ttyin/mark-parity-errors
|
|
|
|
|
ttyin/ignore-break
|
|
|
|
|
ttyin/interrupt-on-break
|
|
|
|
|
ttyin/7bits
|
|
|
|
|
ttyin/cr->nl
|
|
|
|
|
ttyin/ignore-cr
|
|
|
|
|
ttyin/nl->cr
|
|
|
|
|
ttyin/input-flow-ctl
|
|
|
|
|
ttyin/output-flow-ctl)))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-svr4&4.3+bsd-input-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(or (and ttyin/xon-any
|
|
|
|
|
ttyin/beep-on-overflow
|
|
|
|
|
ttyin/lowercase))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-posix-output-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
ttyout/enable))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-svr4&4.3+bsd-output-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(or (and ttyout/nl->crnl
|
|
|
|
|
ttyout/discard-eot
|
|
|
|
|
ttyout/expand-tabs
|
|
|
|
|
ttyout/cr->nl
|
|
|
|
|
ttyout/nl-does-cr
|
|
|
|
|
ttyout/no-col0-cr
|
|
|
|
|
ttyout/delay-w/fill-char
|
|
|
|
|
ttyout/fill-w/del
|
|
|
|
|
ttyout/uppercase)
|
|
|
|
|
(not (and ttyout/nl->crnl
|
|
|
|
|
ttyout/discard-eot
|
|
|
|
|
ttyout/expand-tabs
|
|
|
|
|
ttyout/cr->nl
|
|
|
|
|
ttyout/nl-does-cr
|
|
|
|
|
ttyout/no-col0-cr
|
|
|
|
|
ttyout/delay-w/fill-char
|
|
|
|
|
ttyout/fill-w/del
|
|
|
|
|
ttyout/uppercase)))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-delay-constants-for-output-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(or (and ttyout/bs-delay
|
|
|
|
|
ttyout/bs-delay0
|
|
|
|
|
ttyout/bs-delay1
|
|
|
|
|
ttyout/cr-delay
|
|
|
|
|
ttyout/cr-delay0
|
|
|
|
|
ttyout/cr-delay1
|
|
|
|
|
ttyout/cr-delay2
|
|
|
|
|
ttyout/cr-delay3
|
|
|
|
|
ttyout/ff-delay
|
|
|
|
|
ttyout/ff-delay0
|
|
|
|
|
ttyout/ff-delay1
|
|
|
|
|
ttyout/tab-delay
|
|
|
|
|
ttyout/tab-delay0
|
|
|
|
|
ttyout/tab-delay1
|
|
|
|
|
ttyout/tab-delay2
|
|
|
|
|
ttyout/tab-delayx
|
|
|
|
|
ttyout/nl-delay
|
|
|
|
|
ttyout/nl-delay0
|
|
|
|
|
ttyout/nl-delay1
|
|
|
|
|
ttyout/vtab-delay
|
|
|
|
|
ttyout/vtab-delay0
|
|
|
|
|
ttyout/vtab-delay1
|
|
|
|
|
ttyout/all-delay)
|
|
|
|
|
(not (and ttyout/bs-delay
|
|
|
|
|
ttyout/bs-delay0
|
|
|
|
|
ttyout/bs-delay1
|
|
|
|
|
ttyout/cr-delay
|
|
|
|
|
ttyout/cr-delay0
|
|
|
|
|
ttyout/cr-delay1
|
|
|
|
|
ttyout/cr-delay2
|
|
|
|
|
ttyout/cr-delay3
|
|
|
|
|
ttyout/ff-delay
|
|
|
|
|
ttyout/ff-delay0
|
|
|
|
|
ttyout/ff-delay1
|
|
|
|
|
ttyout/tab-delay
|
|
|
|
|
ttyout/tab-delay0
|
|
|
|
|
ttyout/tab-delay1
|
|
|
|
|
ttyout/tab-delay2
|
|
|
|
|
ttyout/tab-delayx
|
|
|
|
|
ttyout/nl-delay
|
|
|
|
|
ttyout/nl-delay0
|
|
|
|
|
ttyout/nl-delay1
|
|
|
|
|
ttyout/vtab-delay
|
|
|
|
|
ttyout/vtab-delay0
|
|
|
|
|
ttyout/vtab-delay1
|
|
|
|
|
ttyout/all-delay)))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-posix-control-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(and ttyc/char-size
|
|
|
|
|
ttyc/char-size5
|
|
|
|
|
ttyc/char-size6
|
|
|
|
|
ttyc/char-size7
|
|
|
|
|
ttyc/char-size8
|
|
|
|
|
ttyc/enable-parity
|
|
|
|
|
ttyc/odd-parity
|
|
|
|
|
ttyc/enable-read
|
|
|
|
|
ttyc/hup-on-close
|
|
|
|
|
ttyc/no-modem-sync
|
|
|
|
|
ttyc/2-stop-bits)))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-4.3+bsd-control-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(or (and ttyc/ignore-flags
|
|
|
|
|
ttyc/CTS-output-flow-ctl
|
|
|
|
|
ttyc/RTS-input-flow-ctl
|
|
|
|
|
ttyc/carrier-flow-ctl)
|
|
|
|
|
(not (and ttyc/ignore-flags
|
|
|
|
|
ttyc/CTS-output-flow-ctl
|
|
|
|
|
ttyc/RTS-input-flow-ctl
|
|
|
|
|
ttyc/carrier-flow-ctl)))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-posix-local-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(and ttyl/canonical
|
|
|
|
|
ttyl/echo
|
|
|
|
|
ttyl/echo-delete-line
|
|
|
|
|
ttyl/echo-nl
|
|
|
|
|
ttyl/visual-delete
|
|
|
|
|
ttyl/enable-signals
|
|
|
|
|
ttyl/extended
|
|
|
|
|
ttyl/no-flush-on-interrupt
|
|
|
|
|
ttyl/ttou-signal)))
|
|
|
|
|
|
|
|
|
|
(add-test! 'tty-info-record-svr4&4.3+bsd-local-flags 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(or (and ttyl/echo-ctl
|
|
|
|
|
ttyl/flush-output
|
|
|
|
|
ttyl/hardcopy-delete
|
|
|
|
|
ttyl/reprint-unread-chars
|
|
|
|
|
ttyl/visual-delete-line
|
|
|
|
|
ttyl/alt-delete-word
|
|
|
|
|
ttyl/no-kernel-status
|
|
|
|
|
ttyl/case-map)
|
|
|
|
|
(not (and ttyl/echo-ctl
|
|
|
|
|
ttyl/flush-output
|
|
|
|
|
ttyl/hardcopy-delete
|
|
|
|
|
ttyl/reprint-unread-chars
|
|
|
|
|
ttyl/visual-delete-line
|
|
|
|
|
ttyl/alt-delete-word
|
|
|
|
|
ttyl/no-kernel-status
|
2004-10-03 07:35:21 -04:00
|
|
|
ttyl/case-map)))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'open-pty-test 'terminal-device-control
|
2006-03-29 08:37:58 -05:00
|
|
|
(lambda ()
|
|
|
|
|
(receive (pty-inport tty-name) (open-pty)
|
|
|
|
|
(let ((tty-in (open-input-file tty-name)))
|
|
|
|
|
(let ((pty-out (dup->outport pty-inport)))
|
|
|
|
|
(write 23 pty-out)
|
|
|
|
|
(newline pty-out)
|
|
|
|
|
(let ((res (equal? 23 (read tty-in))))
|
|
|
|
|
(close-output-port pty-out) ;; necessary on some systems for proper exit
|
|
|
|
|
res))))))
|
|
|
|
|
|
|
|
|
|
(add-test! 'fork-pty-session 'terminal-device-control
|
|
|
|
|
(lambda ()
|
|
|
|
|
(receive (process pty-in pty-out tty-name)
|
|
|
|
|
(fork-pty-session (lambda ()
|
|
|
|
|
(let ((inp (read)))
|
|
|
|
|
(write (string-append inp inp)))
|
|
|
|
|
(newline)))
|
|
|
|
|
(let ((ti (copy-tty-info (tty-info pty-in))))
|
|
|
|
|
(set-tty-info:local-flags ti
|
|
|
|
|
(bitwise-xor ttyl/echo (tty-info:local-flags ti)))
|
|
|
|
|
(set-tty-info/now pty-in ti))
|
|
|
|
|
(write "hello" pty-out)
|
|
|
|
|
(newline pty-out)
|
|
|
|
|
(let ((reply (read pty-in)))
|
|
|
|
|
(close-output-port pty-out) ;; necessary on some systems for proper exit
|
|
|
|
|
(string=? "hellohello" reply)))))
|
