suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/system: fix problems with checking and empty-string arguments

Browse Source
This commit is contained in:
Matthew Flatt 2011-02-20 11:25:25 -07:00
parent fca0ed2111
commit 33d01a681e
2 changed files with 48 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/mzlib/process.rkt
View File

@ -78,6 +78,19 @@
(raise-type-error who "path or string" exe))
exe)
(define (path-or-ok-string? s)
;; use `path-string?' t check for nul characters in a string,
;; but allow the empty string (which is not an ok path), too:
(or (path-string? s)
(equal? "" s)))
(define (string-no-nuls? s)
(and (string? s) (path-or-ok-string? s)))
(define (bytes-no-nuls? s)
(and (bytes? s)
(not (regexp-match? #rx#"\0" s))))
(define (check-args who args)
(cond
[(null? args) (void)]
@ -89,7 +102,7 @@
(car args)))
(unless (and (>= 2 (length args))
(string? (cadr args))
(path-string? (cadr args)))
(path-or-ok-string? (cadr args)))
(raise-mismatch-error who
"expected a single string argument after 'exact, given: "
(cadr args)))
@ -100,17 +113,16 @@
(caddr args)))]
[else
(for ([s (in-list args)])
(unless (or (path-string? s)
(and (bytes? s) ((bytes-length s) . > . 0)
(not (regexp-match? #rx"\0" s))))
(raise-type-error who "path, string, or byte string (without NULs)"
(unless (or (path-or-ok-string? s)
(bytes-no-nuls? s))
(raise-type-error who "path, string, or byte string (without nuls)"
s)))])
args)
(define (check-command who str)
(unless (or (string? str)
(bytes? str))
(raise-type-error who "string or byte string" str)))
(unless (or (string-no-nuls? str)
(bytes-no-nuls? str))
(raise-type-error who "string or byte string (without nuls)" str)))
;; Old-style functions: ----------------------------------------

28
collects/tests/racket/subprocess.rktl
View File

@ -324,6 +324,34 @@
(system/exit-code (path->string cat))))
(test "Hi\n" get-output-string out))
;; empty strings and nul checks ------------------------------------------------------
(err/rt-test (subprocess #f #f #f ""))
(err/rt-test (process* ""))
(err/rt-test (system* ""))
(let ([no-nuls (lambda (thunk)
(err/rt-test (thunk) (lambda (exn)
(regexp-match? #rx"without nuls" (exn-message exn)))))])
(no-nuls (lambda () (subprocess #f #f #f cat "\0")))
(no-nuls (lambda () (subprocess #f #f #f cat #"\0")))
(no-nuls (lambda () (process "\0")))
(no-nuls (lambda () (process* cat "\0")))
(no-nuls (lambda () (process*/ports #f #f #f cat "\0")))
(no-nuls (lambda () (system "\0")))
(no-nuls (lambda () (system* cat "\0"))))
(let ([call-empty-arg
(lambda (empty-arg)
(let ([out (open-output-string)])
(test #t 'system-empty-string
(parameterize ([current-input-port (open-input-string "Hi\n")]
[current-output-port out])
(system* self "-e" "(current-command-line-arguments)" empty-arg)))
(test "'#(\"\")\n" get-output-string out)))])
(call-empty-arg "")
(call-empty-arg #""))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nested tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;