www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

do-tests.rkt (1453B)


      1 #lang racket/base
      2 
      3 (provide do-tests)
      4 
      5 (require (for-syntax racket/base syntax/parse racket/syntax syntax/stx))
      6 (require racket/match racket/system racket/port racket/format)
      7 
      8 (define R (path->string (find-system-path 'exec-file)))
      9 
     10 (define (mk-process-cmd r path)
     11   (string-append "time " r " " path))
     12 
     13 ;; do-tests : abstracts and interleaves the following def, reporting, and cleanup:
     14 ;;  (match-define (list i1 o1 id1 err1 f1)
     15 ;;    (process "time racket run-mlish-tests1.rkt"))
     16 ;;  (displayln "---- tests: General MLish tests: -----------------------------")
     17 ;;  (write-string (port->string err1))
     18 ;;  (write-string (port->string i1))
     19 ;;  (close-input-port i1)
     20 ;;  (close-output-port o1)
     21 ;;  (close-input-port err1)
     22 (define-syntax (do-tests stx)
     23   (syntax-parse stx
     24     [(_ (~seq path name) ...)
     25      #:with (in ...) (generate-temporaries #'(path ...))
     26      #:with (out ...) (generate-temporaries #'(path ...))
     27      #:with (err ...) (generate-temporaries #'(path ...))
     28      #'(begin
     29          (match-define (list in out _ err _)
     30            (process (mk-process-cmd R path))) ...
     31          (begin
     32            (displayln 
     33              (~a (string-append "----- " name " tests:") 
     34                #:pad-string "-"   
     35                #:min-width 80))
     36            (write-string (port->string err))
     37            (write-string (port->string in))) ...
     38          (close-input-port in) ...
     39          (close-output-port out) ...
     40          (close-input-port err) ...)]))
     41