scsh-0.6/scsh/test/terminal-device-control-tes...

275 lines
7.1 KiB
Scheme
Raw Normal View History

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)))
(or (integer? (tty-info:input-speed ti))
(not (tty-info:input-speed ti)))
(or (integer? (tty-info:output-speed ti))
(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-svr4&4.3+bsd-indicies-test 'terminal-device-control
(lambda ()
(or (and ttychar/delayed-suspend
ttychar/delete-word
ttychar/discard
ttychar/eol2
ttychar/literal-next
ttychar/reprint
ttychar/status)
(not (and ttychar/delayed-suspend
ttychar/delete-word
ttychar/discard
ttychar/eol2
ttychar/literal-next
ttychar/reprint
ttychar/status)))))
(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
ttyl/case-map)))))
(add-test! 'open-pty-test 'terminal-device-control
(lambda ()
(receive (pty-inport tty-name) (open-pty)
(and (tty? pty-inport)
(equal? tty-name (tty-file-name pty-inport))))))