From d59c510941e86c140523abf3d0792b75a3669b45 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Fri, 1 Jul 2016 12:43:01 -0400 Subject: [PATCH] factor out do-tests macro --- macrotypes/examples/tests/do-tests.rkt | 41 ++++++++++++++++ .../examples/tests/run-all-mlish-tests.rkt | 47 ++----------------- .../examples/tests/run-all-mlish-tests.rkt | 47 ++----------------- 3 files changed, 51 insertions(+), 84 deletions(-) create mode 100644 macrotypes/examples/tests/do-tests.rkt diff --git a/macrotypes/examples/tests/do-tests.rkt b/macrotypes/examples/tests/do-tests.rkt new file mode 100644 index 0000000..4aedfe9 --- /dev/null +++ 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 index f97bbb3..cc5e151 100644 --- 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 index f97bbb3..cc5e151 100644 --- 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")