commit d59c510941e86c140523abf3d0792b75a3669b45
parent 1d50b065b984544bb9809d401524de5cdbcdfb03
Author: AlexKnauth <alexander@knauth.org>
Date: Fri, 1 Jul 2016 12:43:01 -0400
factor out do-tests macro
Diffstat:
3 files changed, 51 insertions(+), 84 deletions(-)
diff --git a/macrotypes/examples/tests/do-tests.rkt b/macrotypes/examples/tests/do-tests.rkt
@@ -0,0 +1,41 @@
+#lang racket/base
+
+(provide do-tests)
+
+(require (for-syntax racket/base syntax/parse racket/syntax syntax/stx))
+(require racket/match racket/system racket/port racket/format)
+
+(define R (path->string (find-system-path 'exec-file)))
+
+(define (mk-process-cmd r path)
+ (string-append "time " r " " path))
+
+;; do-tests : 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 path name) ...)
+ #:with (in ...) (generate-temporaries #'(path ...))
+ #:with (out ...) (generate-temporaries #'(path ...))
+ #:with (err ...) (generate-temporaries #'(path ...))
+ #'(begin
+ (match-define (list in out _ err _)
+ (process (mk-process-cmd R path))) ...
+ (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) ...)]))
+
diff --git a/macrotypes/examples/tests/run-all-mlish-tests.rkt b/macrotypes/examples/tests/run-all-mlish-tests.rkt
@@ -1,45 +1,8 @@
#lang racket/base
-(require (for-syntax racket/base syntax/parse racket/syntax syntax/stx))
-(require racket/match racket/system racket/port racket/format)
-(define R (path->string (find-system-path 'exec-file)))
+(require macrotypes/examples/tests/do-tests)
-(define (mk-process-cmd r n)
- (string-append "time " r " run-mlish-tests" (number->string n) ".rkt"))
-
-(define-for-syntax ((mk-num-id str) n-stx)
- (format-id n-stx (string-append str "~a") (syntax-e n-stx)))
-
-;; do-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")
+(do-tests "run-mlish-tests1.rkt" "General MLish"
+ "run-mlish-tests2.rkt" "Shootout and RW OCaml"
+ "run-mlish-tests3.rkt" "Ben's"
+ "run-mlish-tests4.rkt" "Okasaki / polymorphic recursion")
diff --git a/turnstile/examples/tests/run-all-mlish-tests.rkt b/turnstile/examples/tests/run-all-mlish-tests.rkt
@@ -1,45 +1,8 @@
#lang racket/base
-(require (for-syntax racket/base syntax/parse racket/syntax syntax/stx))
-(require racket/match racket/system racket/port racket/format)
-(define R (path->string (find-system-path 'exec-file)))
+(require macrotypes/examples/tests/do-tests)
-(define (mk-process-cmd r n)
- (string-append "time " r " run-mlish-tests" (number->string n) ".rkt"))
-
-(define-for-syntax ((mk-num-id str) n-stx)
- (format-id n-stx (string-append str "~a") (syntax-e n-stx)))
-
-;; do-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")
+(do-tests "run-mlish-tests1.rkt" "General MLish"
+ "run-mlish-tests2.rkt" "Shootout and RW OCaml"
+ "run-mlish-tests3.rkt" "Ben's"
+ "run-mlish-tests4.rkt" "Okasaki / polymorphic recursion")
