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

abstract and cleanup run-all-mlish-tests script

Browse Source
This commit is contained in:
Stephen Chang 2016-05-03 14:22:58 -04:00
parent 64d1bc9a48
commit 33e39c5e96
1 changed files with 55 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
tapl/tests/run-all-mlish-tests.rkt
View File

@ -1,37 +1,59 @@
#lang racket/base
(require racket/match racket/system racket/port)
(require (for-syntax racket/base syntax/parse racket/syntax syntax/stx))
(require racket/match racket/system racket/port setup/dirs racket/format)
(match-define (list i1 o1 id1 err1 f1)
(process "time racket run-mlish-tests1.rkt"))
(match-define (list i2 o2 id2 err2 f2)
(process "time racket run-mlish-tests2.rkt"))
(match-define (list i3 o3 id3 err3 f3)
(process "time racket run-mlish-tests3.rkt"))
(match-define (list i4 o4 id4 err4 f4)
(process "time racket run-mlish-tests4.rkt"))
(define PLT-ROOT/REV (cdr (reverse (explode-path (find-collects-dir)))))
(define BIN "bin")
(define R
(path->string (apply build-path (reverse `("racket" ,BIN . ,PLT-ROOT/REV)))))
(displayln "----- General MLish tests: --------------------------------------")
(write-string (port->string err1))
(write-string (port->string i1))
(displayln "----- Shootout and RW OCaml tests: ------------------------------")
(write-string (port->string err2))
(write-string (port->string i2))
(displayln "----- Ben's tests: ----------------------------------------------")
(write-string (port->string err3))
(write-string (port->string i3))
(displayln "----- Okasaki / polymorphic recursion tests: --------------------")
(write-string (port->string err4))
(write-string (port->string i4))
(define (mk-process-cmd r n)
(string-append "time " r " run-mlish-tests" (number->string n) ".rkt"))
(close-input-port i1)
(close-output-port o1)
(close-input-port err1)
(close-input-port i2)
(close-output-port o2)
(close-input-port err2)
(close-input-port i3)
(close-output-port o3)
(close-input-port err3)
(close-input-port i4)
(close-output-port o4)
(close-input-port err4)
(define-for-syntax ((mk-num-id str) n-stx)
(format-id n-stx (string-append str "~a") (syntax-e n-stx)))
(define-syntax (start stx)
(syntax-parse stx
[(_ n)
#:with in (mk-num-id "i" #'n)
#:with out (mk-num-id "o" #'n)
#:with id (mk-num-id "id" #'n)
#:with err (mk-num-id "err" #'n)
#:with f (mk-num-id "f" #'n)
#'(match-define (list in out id err f)
(process (mk-process R n)))]))
;; test: abstracts and interleaves the following def, reporting, and cleanup:
;; (match-define (list i1 o1 id1 err1 f1)
;; (process "time racket run-mlish-tests1.rkt"))
;; (displayln "---- tests: General MLish tests: -----------------------------")
;; (write-string (port->string err1))
;; (write-string (port->string i1))
;; (close-input-port i1)
;; (close-output-port o1)
;; (close-input-port err1)
(define-syntax (do-tests stx)
(syntax-parse stx
[(_ (~seq n name) ...)
#:with (in ...) (stx-map (mk-num-id "i") #'(n ...))
#:with (out ...) (stx-map (mk-num-id "o") #'(n ...))
#:with (err ...) (stx-map (mk-num-id "err") #'(n ...))
#'(begin
(match-define (list in out _ err _)
(process (mk-process-cmd R n))) ...
(begin
(displayln
(~a (string-append "----- " name " tests:")
#:pad-string "-"
#:min-width 80))
(write-string (port->string err))
(write-string (port->string in))) ...
(close-input-port in) ...
(close-output-port out) ...
(close-input-port err) ...)]))
(do-tests 1 "General MLish"
2 "Shootout and RW OCaml"
3 "Ben's"
4 "Okasaki / polymorphic recursion")