added manual expression and module evaluating

cover.rkt

@@ -1,5 +1,8 @@
 #lang racket/base
-(provide test-files! clear-coverage! get-test-coverage)
+(provide test-files! eval-expression! eval-module!
+         initialize-cover-environment! clear-coverage!
+         get-test-coverage
+         current-cover-environment environment?)
 
 #|
 
@@ -17,6 +20,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
          syntax/modread
          syntax/parse
          unstable/syntax
+         racket/bool
          racket/runtime-path
          racket/match
          rackunit
@@ -26,13 +30,13 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
          "private/shared.rkt"
          "private/file-utils.rkt")
 
-;; namespace used for coverage
+(struct environment (namespace compile ann-top raw-cover cch))
-(define ns #f)
+
+;;; ---------------------- Running Files ---------------------------------
 
 ;; Test files and build coverage map
 ;; returns true if no tests reported as failed, and no files errored.
-(define (test-files!  #:submod [submod-name 'test] . files)
+(define (test-files! #:submod [submod-name 'test] . files)
-  (unless ns (unloaded-error))
   (define abs
     (for/list ([p (in-list files)])
       (if (list? p)
@@ -45,9 +49,6 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
         [(? input-port? p)
          (object-name p)]
         [_ p])))
-  (parameterize ([current-load/use-compiled (make-cover-load/use-compiled abs-names)]
-                 [current-output-port
-                  (if (verbose) (current-output-port) (open-output-nowhere))])
     (define tests-failed #f)
     (for ([p (in-list abs)])
       (vprintf "attempting to run ~s\n" p)
@@ -63,9 +64,12 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
                                [else
                                 (set! tests-failed #t)
                                 (error-display x)]))])
-        (parameterize* ([current-command-line-arguments argv]
+        (parameterize* ([current-load/use-compiled (make-cover-load/use-compiled abs-names)]
+                        [current-output-port
+                         (if (verbose) (current-output-port) (open-output-nowhere))]
+                        [current-command-line-arguments argv]
                         [exit-handler (lambda (x) (raise (an-exit x)))]
-                        [current-namespace ns]
+                        [current-namespace (get-namespace)]
                         [(get-check-handler-parameter)
                          (lambda x
                            (set! tests-failed #t)
@@ -74,12 +78,22 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
           (run-file the-file submod-name))))
     (vprintf "ran ~s\n" files)
     (remove-unneeded-results! abs-names)
-    (not tests-failed)))
+    (not tests-failed))
 
-;; (U InputPort PathString) -> (U InputPort PathString)
+;; ModulePath -> Void
-;; like ->absolute but handles ports
+;; visit and instantiate the given module path in the cover environment
-(define (->absolute/port p)
+(define (eval-module! to-run)
-  (if (port? p) p (->absolute p)))
+  (eval-expression! (make-dyn-req-expr to-run)))
+
+;; Any -> Any
+;; Evaluate the expression in the testing namespace with the cover's compiler
+(define (eval-expression! e)
+  (parameterize ([current-load/use-compiled (make-cover-load/use-compiled #f)]
+                 [current-compile (get-compile)]
+                 [current-namespace (get-namespace)])
+    (eval e)))
+
+;;; ---------------------- Running Aux ---------------------------------
 
 (define (run-file the-file submod-name)
   (cond [(input-port? the-file)
@@ -89,20 +103,36 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
          (define submod `(submod ,sfile ,submod-name))
          (run-mod (if (module-declared? submod #t) submod sfile))]))
 
-;; ModulePath -> Void
-;; evaluate the current module in the current namespace
 (define (run-mod to-run)
   (vprintf "running ~s\n" to-run)
-  (eval `(dynamic-require ',to-run 0))
+  (eval (make-dyn-req-expr to-run))
   (vprintf "finished running ~s\n" to-run))
 
-;; [Listof Path] -> Loader Compiler
+;; (U InputPort PathString) -> (U InputPort PathString)
+;; like ->absolute but handles ports
+(define (->absolute/port p)
+  (if (port? p) p (->absolute p)))
+
+(define (make-dyn-req-expr to-run)
+  `(dynamic-require ',to-run 0))
+
+;; [Listof Any] -> Void
+;; remove any files not in paths from the raw coverage
+(define (remove-unneeded-results! names)
+  (define c (get-raw-coverage))
+  (for ([s (in-list (hash-keys c))]
+        #:when (not (member (srcloc-source s) names)))
+    (hash-remove! c s)))
+
+;;; ---------------------- Compiling ---------------------------------
+
+;; (U [Listof Path] #f) -> Loader Compiler
 ;; returns a value that can be set of `current-load/use-compiled`
 ;; forces the given files to be recompiled whenever load/use-compiled is called
 (define (make-cover-load/use-compiled paths)
   (define load/use-compiled (current-load/use-compiled))
   (define load (current-load))
-  (define cover-compile (make-cover-compile))
+  (define cover-compile (get-compile))
   (define cover-use-compiled-file-paths
     (cons (build-path "compiled" "cover")
           (use-compiled-file-paths)))
@@ -111,7 +141,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
     (define lst (explode-path abs))
     (define dir-list (take lst (sub1 (length lst))))
     (parameterize ([current-load-relative-directory (apply build-path dir-list)])
-      (if (member abs paths)
+      (if (implies paths (member abs paths))
           (parameterize ([current-compile cover-compile]
                          [use-compiled-file-paths
                           cover-use-compiled-file-paths])
@@ -120,12 +150,12 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
 
 ;; -> Compiler
 ;; makes a value sutable for current-compile, such that compile
-;; annotates the source code. should only be used by `make-cover-load/uze-compiled`
+;; annotates the source code with annotate-top. meant to be called
-(define (make-cover-compile)
+;; only by initialize-cover-environment
+(define (make-cover-compile ns annotate-top)
   (define compile (current-compile))
   (define reg (namespace-module-registry ns))
   (define phase (namespace-base-phase ns))
-  (define annotate-top (get-annotate-top))
   ;; define so its named in stack traces
   (define cover-compile
     (lambda (e immediate-eval?)
@@ -146,55 +176,57 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
       (compile to-compile immediate-eval?)))
   cover-compile)
 
-;; [Listof Any] -> Void
+;;; ---------------------- Environments ---------------------------------
-;; remove any files not in paths from the raw coverage
-(define (remove-unneeded-results! names)
-  (define c (get-raw-coverage))
-  (for ([s (in-list (hash-keys c))]
-        #:when (not (member (srcloc-source s) names)))
-    (hash-remove! c s)))
 
-;; -> Void
-;; clear coverage map. Effectively recreates and rebuilds `ns`
 (define (clear-coverage!)
-  (set! ns (make-base-namespace))
+  (current-cover-environment (initialize-cover-environment! (make-base-namespace))))
+
+(define (initialize-cover-environment! ns)
   (parameterize ([current-namespace ns])
     (namespace-require 'cover/coverage)
     (namespace-require 'cover/strace)
-    (namespace-require 'rackunit))
+    (namespace-require 'rackunit)
-  (load-names!))
+    (define ann (load-annotate-top))
+    (environment
+     ns
+     (make-cover-compile ns ann)
+     ann
+     (load-raw-coverage)
+     (load-current-check-handler))))
 
 ;; -> Void
 ;; loads any needed names from `ns` before it can get polluted.
-(define (load-names!)
+(define (load-names)
-  (load-annotate-top!)
+  (load-annotate-top)
-  (load-raw-coverage!)
+  (load-raw-coverage)
-  (load-current-check-handler!))
+  (load-current-check-handler))
 
-(define ann-top #f)
 (define (get-annotate-top)
-  (or ann-top (unloaded-error)))
+  (get-val environment-ann-top))
-(define (load-annotate-top!)
+(define (load-annotate-top)
-  (set! ann-top (get-ns-var 'annotate-top)))
+  (get-namespace-var 'annotate-top))
 
-(define raw-cover #f)
 (define (get-raw-coverage)
-  (or raw-cover (unloaded-error)))
+  (get-val environment-raw-cover))
-(define (load-raw-coverage!)
+(define (load-raw-coverage)
-  (set! raw-cover (get-ns-var 'coverage)))
+  (get-namespace-var 'coverage))
 
-(define cch #f)
-(define (load-current-check-handler!)
-  (set! cch (get-ns-var 'current-check-handler)))
 (define (get-check-handler-parameter)
-  (or cch (unloaded-error)))
+  (get-val environment-cch))
+(define (load-current-check-handler)
+  (get-namespace-var 'current-check-handler))
 
-(define (unloaded-error)
+(define (get-namespace)
-  (error 'cover "Test coverage not loaded."))
+  (get-val environment-namespace))
 
-(define (get-ns-var sym)
+(define (get-compile)
-  (namespace-variable-value sym #t #f ns))
+  (get-val environment-compile))
 
+(define (get-val access)
+  (access (current-cover-environment)))
+
+(define (get-namespace-var sym)
+  (namespace-variable-value sym #t #f (current-namespace)))
 
 ;; -> [Hashof PathString (Listof (List Boolean srcloc))]
 ;; returns a hash of file to a list, where the first of the list is if
@@ -217,9 +249,8 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
                   null))
   out)
 
-;; A little hack to setup coverage namespace for the first time
+(define current-cover-environment
-(clear-coverage!)
+  (make-parameter (initialize-cover-environment! (make-base-namespace))))
-
 
 ;; here live tests for actually saving compiled files
 (module+ test
@@ -230,15 +261,14 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
      "tests/compiled/prog_rkt.zo"
      "tests/compiled/prog_rkt.dep"))
   (test-begin
-   (after
+   (parameterize ([current-cover-environment (initialize-cover-environment! (make-base-namespace))])
-    (for-each (lambda (f) (when (file-exists? f) (delete-file f)))
+     (for-each (lambda (f) (when (file-exists? f) (delete-file f)))
-              compiled)
+               compiled)
-    (check-false (ormap file-exists? compiled))
+     (check-false (ormap file-exists? compiled))
-    (check-not-exn
+     (check-not-exn
-     (lambda ()
+      (lambda ()
-       (parameterize ([current-load/use-compiled
+        (parameterize ([current-load/use-compiled
-                       (make-cover-load/use-compiled (list (->absolute prog.rkt)))]
+                        (make-cover-load/use-compiled (list (->absolute prog.rkt)))]
-                      [current-namespace ns])
+                       [current-namespace (get-namespace)])
-         (managed-compile-zo prog.rkt))))
+          (managed-compile-zo prog.rkt))))
-    (check-true (andmap file-exists? compiled))
+     (check-true (andmap file-exists? compiled)))))
-    (clear-coverage!))))

main.rkt

@@ -5,6 +5,7 @@
 (provide
  (contract-out
   [coverage/c contract?]
+
   [file-coverage/c contract?]
   [test-files! (->* () (#:submod symbol?)
                     #:rest
@@ -13,8 +14,16 @@
                                           (and/c (lambda (v) (not (impersonator? v)))
                                                  (vectorof string? #:immutable #t)))))
                     any)]
+  [eval-expression! (-> any/c any)]
+  [eval-module! (-> module-path? any)]
+
+  [environment? (-> any/c any/c)]
   [clear-coverage! (-> any)]
+  [initialize-cover-environment! (-> namespace? environment?)]
+  [current-cover-environment (parameter/c environment?)]
+
   [get-test-coverage (-> coverage/c)]
+
   [irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))]
   [make-covered?
    (-> file-coverage/c path-string?