diff --git a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/make-mutants.rkt b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/make-mutants.rkt index 548489761b..b2fa1395b5 100644 --- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/make-mutants.rkt +++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/make-mutants.rkt @@ -4,21 +4,24 @@ racket/runtime-path) (provide directories + get-directories + get-directory get-base-stem) -(define-runtime-path stlc "stlc") -(define-runtime-path stlc-sub "stlc-sub") -(define-runtime-path poly-stlc "poly-stlc") -(define-runtime-path rbtrees "rbtrees") -(define-runtime-path delim-cont "delim-cont") -(define-runtime-path list-machine "list-machine") +(define directories (list "stlc" + "stlc-sub" + "poly-stlc" + "rbtrees" + "delim-cont" + "list-machine")) + +(define-runtime-path here ".") -(define directories (list stlc - stlc-sub - poly-stlc - rbtrees - delim-cont - list-machine)) +(define (get-directory name) + (build-path here name)) + +(define (get-directories names) + (map get-directory names)) (define (make-mutants directory) (cond @@ -35,7 +38,7 @@ (copy-file base name #t) (system* (find-executable-path "patch") name (path->string f)))] [else - (map make-mutants directories)])) + (map make-mutants (get-directories directories))])) (define (get-base-stem files) (car (filter-map (λ (f) (regexp-match #rx"^(.*)-base\\.rkt$" (path->string f))) files))) diff --git a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/run-muts.rkt b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/run-muts.rkt index 065d9bba68..391b26d144 100644 --- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/run-muts.rkt +++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/run-muts.rkt @@ -6,6 +6,7 @@ racket/place racket/match racket/system + racket/runtime-path "make-mutants.rkt") (define names '()) @@ -35,17 +36,18 @@ [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref" (set! gen-types (cons (string->symbol t) gen-types))]) +(define-runtime-path here ".") + (when (empty? files) (set! files (flatten - (for/list ([name (in-list names)]) - (define path (build-path (current-directory) name)) - (filter - (curry regexp-match #px"^.*([\\d]+|base)\\.rkt$") - (map - (λ (fp) - (string-append name "/" (path->string fp))) - (directory-list path))))))) + (for/list ([dir (in-list names)]) + (map + (λ (fn) + (string-append dir "/" (path->string fn))) + (filter + (curry regexp-match #px"^.*([\\d]+|base)\\.rkt$") + (directory-list (get-directory dir)))))))) (define worklist files) @@ -58,10 +60,9 @@ (semaphore-post work-sem) (void)] [else - (define fname (car worklist)) + (define path (simplify-path (build-path here (car worklist)))) (set! worklist (cdr worklist)) (semaphore-post work-sem) - (define fullpath (build-path (current-directory) fname)) (define args (apply string-append (add-between (list* (if verbose? "-v" "") (string-append "-m " (number->string minutes)) @@ -70,8 +71,8 @@ (symbol->string t))) gen-types)) " "))) - - (system (let ([ans (apply string-append (add-between (list "racket" "test-file.rkt" args (path->string fullpath)) " "))]) + (system (let ([ans (apply string-append (add-between (list "racket" (path->string (build-path here "test-file.rkt")) + args (path->string path)) " "))]) (printf "~s\n" ans) ans)) (do-next)])) diff --git a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt index 060951edcf..207c6f2c31 100644 --- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt +++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt @@ -5,6 +5,7 @@ racket/list racket/set racket/match + racket/path math/statistics) (define minutes 1) @@ -102,16 +103,20 @@ ((/ dev avg) . > . 0.1))) (define (test-file fname verbose? no-errs? gen-type seconds) - (define tc (dynamic-require fname 'type-check)) - (define check (dynamic-require fname 'check)) - (define gen-term (dynamic-require fname 'generate-M-term)) - (define gen-typed-term (dynamic-require fname 'generate-typed-term)) - (define typed-generator (dynamic-require fname 'typed-generator)) - (define gen-enum (dynamic-require fname 'generate-enum-term)) - (define err (dynamic-require fname 'the-error)) + (define maybe-fpath (string->path fname)) + (define fpath (if (relative-path? maybe-fpath) + maybe-fpath + (find-relative-path (current-directory) maybe-fpath))) + (define tc (dynamic-require fpath 'type-check)) + (define check (dynamic-require fpath 'check)) + (define gen-term (dynamic-require fpath 'generate-M-term)) + (define gen-typed-term (dynamic-require fpath 'generate-typed-term)) + (define typed-generator (dynamic-require fpath 'typed-generator)) + (define gen-enum (dynamic-require fpath 'generate-enum-term)) + (define err (dynamic-require fpath 'the-error)) (printf "\n-------------------------------------------------------------------\n") - (printf "~a has the error: ~a\n\n" fname err) - (printf "Running ~a....\n" fname) + (printf "~a has the error: ~a\n\n" fpath err) + (printf "Running ~a....\n" fpath) (printf "Using generator: ~s\n" gen-type) (define (gen-and-type gen) (λ () @@ -121,16 +126,16 @@ t)))) (cond [(equal? gen-type 'grammar) - (run-generations fname verbose? no-errs? (gen-and-type gen-term) + (run-generations fpath verbose? no-errs? (gen-and-type gen-term) check seconds gen-type)] [(equal? gen-type 'enum) - (run-generations fname verbose? no-errs? (gen-and-type gen-enum) + (run-generations fpath verbose? no-errs? (gen-and-type gen-enum) check seconds gen-type)] [(equal? gen-type 'search) - (run-generations fname verbose? no-errs? (λ () gen-typed-term) + (run-generations fpath verbose? no-errs? (λ () gen-typed-term) check seconds gen-type)] [(equal? gen-type 'search-gen) - (run-generations fname verbose? no-errs? typed-generator + (run-generations fpath verbose? no-errs? typed-generator check seconds gen-type)] [(equal? gen-type 'search-gen-ref) (define t (current-process-milliseconds)) @@ -140,11 +145,11 @@ (set! t (current-process-milliseconds)) (set! g (typed-generator))) (g)) - (run-generations fname verbose? no-errs? (λ () gen) + (run-generations fpath verbose? no-errs? (λ () gen) check seconds gen-type)] [(equal? gen-type 'search-gen-enum) (parameterize ([gen-state (set-remove (gen-state) 'shuffle-clauses)]) - (run-generations fname verbose? no-errs? typed-generator + (run-generations fpath verbose? no-errs? typed-generator check seconds gen-type))] [(equal? gen-type 'search-gen-enum-ref) (parameterize ([gen-state (set-remove (gen-state) 'shuffle-clauses)]) @@ -155,7 +160,7 @@ (set! t (current-process-milliseconds)) (set! g (typed-generator))) (g)) - (run-generations fname verbose? no-errs? (λ () gen) + (run-generations fpath verbose? no-errs? (λ () gen) check seconds gen-type))])) (for ([gen-type (in-list types)])