mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 04:40:29 +02:00
Code Activity

* expect.scm: Turn this into a module, (ice-9 expect).

Browse source 
(expect-port, expect-timeout, expect-timeout-proc,
expect-eof-proc, expect-char-proc, expect, expect-strings,
expect-select): Make these public definitions.
(expect-strings): Use make-regexp and regexp-exec, instead of
regcomp and regexec.  We've omitted the REG_NEWLINE flag; hope
that's okay.
This commit is contained in:
Jim Blandy 1997-06-13 05:50:37 +00:00
parent c6b15ad07e
commit ec8469e7cb
1 changed files with 15 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

28
ice-9/expect.scm
View file

@ -19,20 +19,22 @@
;;;;
(define-module (ice-9 expect))
;;; Expect: a macro for selecting actions based on what it reads from a port.
;;; The idea is from Don Libes' expect based on Tcl.
;;; This version by Gary Houston incorporating ideas from Aubrey Jaffer.
(define expect-port #f)
(define expect-timeout #f)
(define expect-timeout-proc #f)
(define expect-eof-proc #f)
(define expect-char-proc #f)
(define-public expect-port #f)
(define-public expect-timeout #f)
(define-public expect-timeout-proc #f)
(define-public expect-eof-proc #f)
(define-public expect-char-proc #f)
;;; expect: each test is a procedure which is applied to the accumulating
;;; string.
(defmacro expect clauses
(defmacro-public expect clauses
(let ((s (gentemp))
(c (gentemp))
(port (gentemp))
@ -66,8 +68,8 @@
(set! ,s (string-append ,s (string ,c)))
(cond
,@(let next-expr ((tests (map car clauses))
(exprs (map cdr clauses))
(body ()))
(exprs (map cdr clauses))
(body ()))
(cond
((null? tests)
(reverse body))
@ -96,7 +98,7 @@
;;; the regexec front-end to expect:
;;; each test must evaluate to a regular expression.
(defmacro expect-strings clauses
(defmacro-public expect-strings clauses
`(let ,@(let next-test ((tests (map car clauses))
(exprs (map cdr clauses))
(defs ())
@ -107,17 +109,17 @@
(let ((rxname (gentemp)))
(next-test (cdr tests)
(cdr exprs)
(cons `(,rxname (regcomp ,(car tests)
REG_NEWLINE))
;; should maybe use REG_NEWLINE below?
(cons `(,rxname (make-regexp ,(car tests)))
defs)
(cons `((lambda (s)
(regexec ,rxname s ""))
(regexp-exec ,rxname s))
,@(car exprs))
body))))))))
;;; simplified select: returns #t if input is waiting or #f if timed out.
;;; timeout is an absolute time in floating point seconds.
(define (expect-select port timeout)
(define-public (expect-select port timeout)
(let* ((secs-usecs (gettimeofday))
(relative (- timeout
(car secs-usecs)