oke.

testing/jsmaker-test-framework.rkt

@@ -1,57 +1,115 @@
 #lang racket/base
 
-(require rackunit
-         racket/string
-         racket/file
-         racket/system)
+(require racket/file
+         racket/format
+         racket/list
+         racket/port
+         racket/runtime-path
+         racket/string)
 
-(provide check-js-equal?
-         check-js-contains?
-         check-js-matches?
-         node-available?
-         run-js/trimmed)
+(provide check-true
+         check-equal
+         check-matches
+         check-not-matches
+         check-contains
+         check-not-contains
+         check-public-api
+         run-js-if-available
+         note-dropped
+         test-summary)
 
-(define-check (check-js-equal? actual expected)
-  (check-equal? actual expected))
+(define checks-run 0)
+(define checks-skipped 0)
 
-(define-check (check-js-contains? actual needle)
-  (check-true (string-contains? actual needle)
-              (format "expected generated JavaScript to contain ~s, got:\n~a" needle actual)))
+(define (bump!) (set! checks-run (add1 checks-run)))
+(define (skip!) (set! checks-skipped (add1 checks-skipped)))
 
-(define-check (check-js-matches? actual pattern)
-  (check-true (regexp-match? pattern actual)
-              (format "expected generated JavaScript to match ~s, got:\n~a" pattern actual)))
+(define (fail name fmt . args)
+  (error name (apply format fmt args)))
 
-(define (node-available?)
-  (and (find-executable-path "node") #t))
+(define (check-true name value)
+  (bump!)
+  (unless value (fail name "check failed")))
 
-(define (run-js/trimmed program)
-  (define node (find-executable-path "node"))
-  (unless node
-    (error 'run-js/trimmed "node is not available"))
-  (define source-path (make-temporary-file "js-maker-test-~a.js"))
-  (define out-path (make-temporary-file "js-maker-test-out-~a.txt"))
-  (define err-path (make-temporary-file "js-maker-test-err-~a.txt"))
-  (dynamic-wind
-    void
-    (lambda ()
-      (call-with-output-file source-path #:exists 'truncate
-        (lambda (out) (display program out)))
-      (define exit-code
-        (call-with-output-file out-path #:exists 'truncate
-          (lambda (out)
-            (call-with-output-file err-path #:exists 'truncate
-              (lambda (err)
-                (parameterize ([current-output-port out]
-                               [current-error-port err])
-                  (system*/exit-code node source-path)))))))
-      (define stdout (file->string out-path))
-      (define stderr (file->string err-path))
-      (unless (zero? exit-code)
-        (error 'run-js/trimmed
-               "node failed with exit code ~a\nstdout:\n~a\nstderr:\n~a\nprogram:\n~a"
-               exit-code stdout stderr program))
-      (string-trim stdout))
-    (lambda ()
-      (for ([path (list source-path out-path err-path)])
-        (with-handlers ([exn:fail? void]) (delete-file path))))))
+(define (check-equal name actual expected)
+  (bump!)
+  (unless (equal? actual expected)
+    (fail name "expected ~s, got ~s" expected actual)))
+
+(define (check-matches name rx text)
+  (bump!)
+  (unless (regexp-match? rx text)
+    (fail name "expected generated text to match ~s, got:\n~a" rx text)))
+
+(define (check-not-matches name rx text)
+  (bump!)
+  (when (regexp-match? rx text)
+    (fail name "expected generated text not to match ~s, got:\n~a" rx text)))
+
+(define (check-contains name needle text)
+  (bump!)
+  (unless (string-contains? text needle)
+    (fail name "expected generated text to contain ~s, got:\n~a" needle text)))
+
+(define (check-not-contains name needle text)
+  (bump!)
+  (when (string-contains? text needle)
+    (fail name "expected generated text not to contain ~s, got:\n~a" needle text)))
+
+(define-runtime-path main-path "../main.rkt")
+
+(define (all-symbols v)
+  (cond [(symbol? v) (list v)]
+        [(pair? v) (append (all-symbols (car v)) (all-symbols (cdr v)))]
+        [else null]))
+
+(define (check-public-api)
+  (define mp `(file ,(path->string main-path)))
+  (dynamic-require mp #f)
+  (define-values (value-exports syntax-exports) (module->exports mp))
+  (define exports (remove-duplicates (append (all-symbols value-exports)
+                                             (all-symbols syntax-exports))))
+  (check-true 'public-api-js (memq 'js exports))
+  (check-true 'public-api-no-js1 (not (memq 'js1 exports)))
+  (check-true 'public-api-no-js-ref (not (memq 'js-ref exports)))
+  (check-true 'public-api-no-js/expression (not (memq 'js/expression exports))))
+
+(define (candidate-node)
+  (define env-node (getenv "JSMAKER_NODE"))
+  (cond [(and env-node (not (string=? env-node ""))) env-node]
+        [else (find-executable-path "node")]))
+
+(define (subprocess-output executable file)
+  (define-values (proc stdout stdin stderr)
+    (subprocess #f #f #f executable file))
+  (close-output-port stdin)
+  (define out (port->string stdout))
+  (define err (port->string stderr))
+  (subprocess-wait proc)
+  (values (subprocess-status proc) out err))
+
+(define (run-js-if-available name program expected-stdout)
+  (define node (candidate-node))
+  (cond
+    [node
+     (bump!)
+     (define file (make-temporary-file "jsmaker-~a.js"))
+     (call-with-output-file file #:exists 'replace
+       (lambda (out) (display program out)))
+     (define-values (status stdout stderr) (subprocess-output node file))
+     (delete-file file)
+     (unless (and (zero? status) (string=? (string-trim stdout) expected-stdout))
+       (fail name "JavaScript execution failed; status=~a stdout=~s stderr=~s program:\n~a"
+             status stdout stderr program))]
+    [else
+     (skip!)
+     (printf "NOTE: ~a skipped because node was not found.\n" name)]))
+
+(define (note-dropped topic reason)
+  (printf "NOTE: dropped old ~a tests: ~a\n" topic reason))
+
+(define (test-summary who)
+  (printf "~a: ~a checks passed" who checks-run)
+  (unless (zero? checks-skipped)
+    (printf ", ~a JavaScript execution checks skipped" checks-skipped))
+  (newline))