116 lines
3.7 KiB
Racket
116 lines
3.7 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/file
|
|
racket/format
|
|
racket/list
|
|
racket/port
|
|
racket/runtime-path
|
|
racket/string)
|
|
|
|
(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 checks-run 0)
|
|
(define checks-skipped 0)
|
|
|
|
(define (bump!) (set! checks-run (add1 checks-run)))
|
|
(define (skip!) (set! checks-skipped (add1 checks-skipped)))
|
|
|
|
(define (fail name fmt . args)
|
|
(error name (apply format fmt args)))
|
|
|
|
(define (check-true name value)
|
|
(bump!)
|
|
(unless value (fail name "check failed")))
|
|
|
|
(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))
|