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