text-lang.rkt (2685B)
1 #lang racket/base 2 3 (require tests/eli-tester racket/runtime-path racket/port racket/sandbox 4 (prefix-in doc: (lib "scribblings/scribble/text.scrbl"))) 5 6 (provide text-lang-tests) 7 (module+ main (text-lang-tests)) 8 (define (text-lang-tests) 9 ;; (sample-file-tests) 10 (test do (in-documentation-tests))) 11 12 ;; unused now 13 (define-runtime-path text-dir "text") 14 (define (sample-file-tests) 15 (parameterize ([current-directory text-dir]) 16 (for ([ifile (map path->string (directory-list))] 17 #:when (and (file-exists? ifile) 18 (regexp-match? #rx"^i[0-9]+\\.ss$" ifile))) 19 (define ofile (regexp-replace #rx"^i([0-9]+)\\..*$" ifile "o\\1.txt")) 20 (define expected (call-with-input-file ofile 21 (lambda (i) (read-bytes (file-size ofile) i)))) 22 (define o (open-output-bytes)) 23 (parameterize ([current-output-port o]) 24 (dynamic-require (path->complete-path ifile) #f)) 25 (test (get-output-bytes o) => expected)))) 26 27 (define-runtime-path this-dir ".") 28 (define (in-documentation-tests) 29 (define (text-test line in-text out-text more) 30 (define-values (i o) (make-pipe 512)) 31 (define-values (expected len-to-read) 32 (let ([m (regexp-match-positions #rx"\n\\.\\.\\.$" out-text)]) 33 (if m 34 (values (substring out-text 0 (caar m)) (caar m)) 35 (values out-text #f)))) 36 ;; test with name indicating the source 37 (define-syntax-rule (t . stuff) 38 (test ;; #:failure-message 39 ;; (format "text-lang test failure at line ~s" line) 40 . stuff)) 41 (parameterize ([current-directory this-dir] 42 [sandbox-output o] 43 [sandbox-error-output current-output-port] 44 [sandbox-eval-limits '(2 10)]) 45 (define exn #f) 46 (define thd #f) 47 (define (run) 48 ;; only need to evaluate the module, so we have its output; but do that 49 ;; in a thread, since we might want to look at just a prefix of an 50 ;; infinite output 51 (with-handlers ([void (lambda (e) (set! exn e))]) 52 (make-module-evaluator in-text) 53 (close-output-port o))) 54 (for ([m more]) 55 (call-with-output-file (car m) #:exists 'truncate 56 (lambda (o) (display (cdr m) o)))) 57 (set! thd (thread run)) 58 (t (if len-to-read (read-string len-to-read i) (port->string i)) 59 => expected) 60 (t (begin (kill-thread thd) (cond [exn => raise] [else #t]))) 61 (for ([m more]) 62 (when (file-exists? (car m)) (delete-file (car m)))))) 63 (call-with-trusted-sandbox-configuration 64 (lambda () 65 (for ([t (in-list (doc:tests))]) 66 (begin (apply text-test t))))))