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

Skip ports tests that require popen if popen not available

Browse source 
* test-suite/tests/ports.test (define-module): don't use (ice-9 popen)
  (if-supported): new syntax
  (pipe:write, pipe:write): disable if no popen provided
  (line-counter): disable if no popen provided
This commit is contained in:
Michael Gran 2017-04-04 09:14:53 -07:00
parent ddbb110e87
commit 147912530c
1 changed files with 89 additions and 82 deletions
Download patch file Download diff file Expand all files Collapse all files

171
test-suite/tests/ports.test
View file

@ -21,7 +21,6 @@
(define-module (test-suite test-ports) (define-module (test-suite test-ports)
#:use-module (test-suite lib) #:use-module (test-suite lib)
#:use-module (test-suite guile-test) #:use-module (test-suite guile-test)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 threads) #:use-module (ice-9 threads)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
@ -618,23 +617,30 @@
;;;; Pipe (popen) ports. ;;;; Pipe (popen) ports.
(define-syntax-rule (if-supported body ...)
(when (provided? 'popen)
(begin body ...)))
(if-supported
(use-modules (ice-9 popen))
;;; Run a command, and read its output. ;;; Run a command, and read its output.
(let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r")) (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
(in-string (read-all pipe))) (in-string (read-all pipe)))
(close-pipe pipe) (close-pipe pipe)
(pass-if "pipe: read" (pass-if "pipe: read"
(equal? in-string "Howdy there, partner!\n"))) (equal? in-string "Howdy there, partner!\n")))
;;; Run a command, send some output to it, and see if it worked. ;;; Run a command, send some output to it, and see if it worked.
(let* ((filename (test-file)) (let* ((filename (test-file))
(pipe (open-pipe (string-append "grep Mommy > " filename) "w"))) (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
(display "Now Jimmy lives on a mushroom cloud\n" pipe) (display "Now Jimmy lives on a mushroom cloud\n" pipe)
(display "Mommy, why does everybody have a bomb?\n" pipe) (display "Mommy, why does everybody have a bomb?\n" pipe)
(close-pipe pipe) (close-pipe pipe)
(let ((in-string (read-file filename))) (let ((in-string (read-file filename)))
(pass-if "pipe: write" (pass-if "pipe: write"
(equal? in-string "Mommy, why does everybody have a bomb?\n"))) (equal? in-string "Mommy, why does everybody have a bomb?\n")))
(delete-file filename)) (delete-file filename)))
(pass-if-equal "pipe, fdopen, and line buffering" (pass-if-equal "pipe, fdopen, and line buffering"
"foo\nbar\n" "foo\nbar\n"
@ -1020,80 +1026,81 @@
;;;; Generic operations across all port types. ;;;; Generic operations across all port types.
(let ((port-loop-temp (test-file))) (if-supported
(let ((port-loop-temp (test-file)))
;; Return a list of input ports that all return the same text. ;; Return a list of input ports that all return the same text.
;; We map tests over this list. ;; We map tests over this list.
(define (input-port-list text) (define (input-port-list text)
;; Create a text file some of the ports will use. ;; Create a text file some of the ports will use.
(let ((out-port (open-output-file port-loop-temp))) (let ((out-port (open-output-file port-loop-temp)))
(display text out-port) (display text out-port)
(close-port out-port)) (close-port out-port))
(list (open-input-file port-loop-temp) (list (open-input-file port-loop-temp)
(open-input-pipe (string-append "cat " port-loop-temp)) (open-input-pipe (string-append "cat " port-loop-temp))
(call-with-input-string text (lambda (x) x)) (call-with-input-string text (lambda (x) x))
;; We don't test soft ports at the moment. ;; We don't test soft ports at the moment.
)) ))
(define port-list-names '("file" "pipe" "string")) (define port-list-names '("file" "pipe" "string"))
;; Test the line counter. ;; Test the line counter.
(define (test-line-counter text second-line final-column) (define (test-line-counter text second-line final-column)
(with-test-prefix "line counter" (with-test-prefix "line counter"
(let ((ports (input-port-list text))) (let ((ports (input-port-list text)))
(for-each (for-each
(lambda (port port-name) (lambda (port port-name)
(with-test-prefix port-name (with-test-prefix port-name
(pass-if "at beginning of input" (pass-if "at beginning of input"
(= (port-line port) 0)) (= (port-line port) 0))
(pass-if "read first character" (pass-if "read first character"
(eqv? (read-char port) #\x)) (eqv? (read-char port) #\x))
(pass-if "after reading one character" (pass-if "after reading one character"
(= (port-line port) 0)) (= (port-line port) 0))
(pass-if "read first newline" (pass-if "read first newline"
(eqv? (read-char port) #\newline)) (eqv? (read-char port) #\newline))
(pass-if "after reading first newline char" (pass-if "after reading first newline char"
(= (port-line port) 1)) (= (port-line port) 1))
(pass-if "second line read correctly" (pass-if "second line read correctly"
(equal? (read-line port) second-line)) (equal? (read-line port) second-line))
(pass-if "read-line increments line number" (pass-if "read-line increments line number"
(= (port-line port) 2)) (= (port-line port) 2))
(pass-if "read-line returns EOF" (pass-if "read-line returns EOF"
(let loop ((i 0)) (let loop ((i 0))
(cond (cond
((eof-object? (read-line port)) #t) ((eof-object? (read-line port)) #t)
((> i 20) #f) ((> i 20) #f)
(else (loop (+ i 1)))))) (else (loop (+ i 1))))))
(pass-if "line count is 5 at EOF" (pass-if "line count is 5 at EOF"
(= (port-line port) 5)) (= (port-line port) 5))
(pass-if "column is correct at EOF" (pass-if "column is correct at EOF"
(= (port-column port) final-column)))) (= (port-column port) final-column))))
ports port-list-names) ports port-list-names)
(for-each close-port ports) (for-each close-port ports)
(delete-file port-loop-temp)))) (delete-file port-loop-temp))))
(with-test-prefix "newline" (with-test-prefix "newline"
(test-line-counter (test-line-counter
(string-append "x\n" (string-append "x\n"
"He who receives an idea from me, receives instruction\n" "He who receives an idea from me, receives instruction\n"
"himself without lessening mine; as he who lights his\n" "himself without lessening mine; as he who lights his\n"
"taper at mine, receives light without darkening me.\n" "taper at mine, receives light without darkening me.\n"
" --- Thomas Jefferson\n") " --- Thomas Jefferson\n")
"He who receives an idea from me, receives instruction" "He who receives an idea from me, receives instruction"
0)) 0))
(with-test-prefix "no newline" (with-test-prefix "no newline"
(test-line-counter (test-line-counter
(string-append "x\n" (string-append "x\n"
"He who receives an idea from me, receives instruction\n" "He who receives an idea from me, receives instruction\n"
"himself without lessening mine; as he who lights his\n" "himself without lessening mine; as he who lights his\n"
"taper at mine, receives light without darkening me.\n" "taper at mine, receives light without darkening me.\n"
" --- Thomas Jefferson\n" " --- Thomas Jefferson\n"
"no newline here") "no newline here")
"He who receives an idea from me, receives instruction" "He who receives an idea from me, receives instruction"
15))) 15))))
;; Test port-line and port-column for output ports ;; Test port-line and port-column for output ports