From 45acda7c3ffe3ffca65a0c2c9c65811aead46807 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Wed, 29 Mar 2006 13:37:58 +0000
Subject: [PATCH] New pty tests and some small fixes

---
 scsh/test/terminal-device-control-test.scm | 54 ++++++++++++----------
 1 file changed, 30 insertions(+), 24 deletions(-)

diff --git a/scsh/test/terminal-device-control-test.scm b/scsh/test/terminal-device-control-test.scm
index 8497ebc..139e71f 100644
--- a/scsh/test/terminal-device-control-test.scm
+++ b/scsh/test/terminal-device-control-test.scm
@@ -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))))))
-	     
\ No newline at end of file
+   (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)))))
\ No newline at end of file