scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

New pty tests and some small fixes

This commit is contained in:
mainzelm 2006-03-29 13:37:58 +00:00
parent 2e37299496
commit 45acda7c3f
1 changed files with 30 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
scsh/test/terminal-device-control-test.scm
View File

@ -21,9 +21,11 @@
(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))
(or (or (integer? (tty-info:input-speed ti))
(memq (tty-info:input-speed ti) '(exta extb)))
(not (tty-info:input-speed ti)))
(or (integer? (tty-info:output-speed ti))
(or (or (integer? (tty-info:output-speed ti))
(memq (tty-info:output-speed ti) '(exta extb)))
(not (tty-info:output-speed ti)))
(or (integer? (tty-info:min ti))
(not (tty-info:min ti)))
@ -100,23 +102,6 @@
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
@ -268,8 +253,29 @@
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))))))
(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)))))