mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

More thorough ice-9 sports testing

Browse source 
* module/ice-9/sports.scm: Export read-line, %read-line, and
  read-delimited.  Add these latest three to install-sports!, and fix
  install-sports! if the current module isn't (ice-9 sports).

* test-suite/tests/sports.test: Use install-sports! instead of lexical
  bindings, to allow us to nicely frob bindings in rdelim.  Include
  rdelim tests.
This commit is contained in:
Andy Wingo 2016-05-22 20:39:03 +02:00
parent 2badbd06f6
commit 2c95a21027
2 changed files with 23 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

29
module/ice-9/sports.scm
View file

@ -56,6 +56,9 @@
read-char) read-char)
#:export (lookahead-u8 #:export (lookahead-u8
get-u8 get-u8
%read-line
read-line
read-delimited
current-read-waiter current-read-waiter
current-write-waiter current-write-waiter
install-sports! install-sports!
@ -524,21 +527,23 @@
(define saved-port-bindings #f) (define saved-port-bindings #f)
(define port-bindings (define port-bindings
'(((guile) read-char peek-char) '(((guile) read-char peek-char)
((ice-9 binary-ports) get-u8 lookahead-u8))) ((ice-9 binary-ports) get-u8 lookahead-u8)
((ice-9 rdelim) %read-line read-line read-delimited)))
(define (install-sports!) (define (install-sports!)
(unless saved-port-bindings (unless saved-port-bindings
(set! saved-port-bindings (make-hash-table)) (set! saved-port-bindings (make-hash-table))
(for-each (let ((sports (resolve-module '(ice-9 sports))))
(match-lambda (for-each
((mod . syms) (match-lambda
(let ((mod (resolve-module mod))) ((mod . syms)
(for-each (lambda (sym) (let ((mod (resolve-module mod)))
(hashq-set! saved-port-bindings sym (for-each (lambda (sym)
(module-ref mod sym)) (hashq-set! saved-port-bindings sym
(module-set! mod sym (module-ref mod sym))
(module-ref (current-module) sym))) (module-set! mod sym
syms)))) (module-ref sports sym)))
port-bindings))) syms))))
port-bindings))))
(define (uninstall-sports!) (define (uninstall-sports!)
(when saved-port-bindings (when saved-port-bindings

7
test-suite/tests/sports.test
View file

@ -17,7 +17,7 @@
;;;; <http://www.gnu.org/licenses/>. ;;;; <http://www.gnu.org/licenses/>.
(define-module (test-suite test-ports) (define-module (test-suite test-ports)
#:use-module (ice-9 sports)) #:use-module ((ice-9 sports) #:select (install-sports! uninstall-sports!)))
;; Include tests from ports.test. ;; Include tests from ports.test.
@ -49,4 +49,9 @@
#`((include-one #,exp) . #,(lp)))))))) #`((include-one #,exp) . #,(lp))))))))
#:guess-encoding #t))))) #:guess-encoding #t)))))
(install-sports!)
(include-tests "tests/ports.test") (include-tests "tests/ports.test")
(include-tests "tests/rdelim.test")
(uninstall-sports!)