From 42c42c739558ca0de7c3a725815ea4dfebb9f2e7 Mon Sep 17 00:00:00 2001 From: Tommy McHugh Date: Sun, 3 Jan 2021 15:13:39 -0600 Subject: [PATCH 1/4] moved reg exp match outside of check-exn and implemented check-compile-time-exn and check-not-compile-time-exn --- rackunit-lib/rackunit/private/check.rkt | 61 ++++++++++++++++++--- rackunit-test/tests/rackunit/check-test.rkt | 3 +- 2 files changed, 56 insertions(+), 8 deletions(-) diff --git a/rackunit-lib/rackunit/private/check.rkt b/rackunit-lib/rackunit/private/check.rkt index 588670f2..85e4e079 100644 --- a/rackunit-lib/rackunit/private/check.rkt +++ b/rackunit-lib/rackunit/private/check.rkt @@ -7,6 +7,7 @@ racket/match rackunit/log syntax/parse/define + syntax/macro-testing "base.rkt" "equal-within.rkt" "check-info.rkt" @@ -29,6 +30,8 @@ check check-exn check-not-exn + check-compile-time-exn + check-not-compile-time-exn check-true check-false check-pred @@ -147,14 +150,16 @@ (procedure-arity-includes? thunk 0)) (raise-arguments-error name "thunk must be a procedure that accepts 0 arguments" "thunk" thunk))) +(define (get-pred raw-pred) + (cond [(regexp? raw-pred) + (λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))] + [(and (procedure? raw-pred) (procedure-arity-includes? raw-pred 1)) + raw-pred] + [else + (raise-argument-error 'check-exn "(or/c (-> any/c any/c) regexp?)" raw-pred)])) + (define-check (check-exn raw-pred thunk) - (let ([pred - (cond [(regexp? raw-pred) - (λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))] - [(and (procedure? raw-pred) (procedure-arity-includes? raw-pred 1)) - raw-pred] - [else - (raise-argument-error 'check-exn "(or/c (-> any/c any/c) regexp?)" raw-pred)])]) + (let ([pred (get-pred raw-pred)]) (raise-error-if-not-thunk 'check-exn thunk) (let/ec succeed (with-handlers @@ -196,6 +201,48 @@ (lambda () (fail-check))))]) (thunk))) +(define-syntax (check-compile-time-exn stx) + (syntax-parse stx + [(_ raw-pred expr:expr) + #:with loc (datum->syntax #f 'loc stx) + #'(let ([pred (get-pred raw-pred)] + [location (syntax->location #'loc)]) + (with-check-info (['name 'check-compile-time-exn] + ['location location] + ['params (list raw-pred (syntax->datum #'expr))]) + (let/ec finish + (with-check-info (['message "Wrong exception raised"]) + (with-handlers + ([pred + (lambda (exn) (finish))] + [exn:fail? + (lambda (exn) + (with-check-info (['exn exn]) + (fail) + (finish)))]) + (convert-compile-time-error expr))) + (with-check-info (['message "No exception raised"]) + (fail)))))])) + +(define-syntax (check-not-compile-time-exn stx) + (syntax-parse stx + [(_ expr:expr) + #:with loc (datum->syntax #f 'loc stx) + #'(let ([location (syntax->location #'loc)]) + (with-check-info (['name 'check-compile-time-exn] + ['location location] + ['params (list (syntax->datum #'expr))]) + (let/ec finish + (with-check-info (['message "Exception raised"]) + (with-handlers + ([exn:fail? + (lambda (exn) + (with-check-info (['exn exn]) + (fail) + (finish)))]) + (convert-compile-time-error expr))) + (finish))))])) + (define-syntax-rule (define-simple-check-values [header body ...] ...) (begin (define-simple-check header body ...) ...)) diff --git a/rackunit-test/tests/rackunit/check-test.rkt b/rackunit-test/tests/rackunit/check-test.rkt index 6e8126eb..8451e5e4 100644 --- a/rackunit-test/tests/rackunit/check-test.rkt +++ b/rackunit-test/tests/rackunit/check-test.rkt @@ -34,7 +34,8 @@ rackunit rackunit/private/check rackunit/private/result - rackunit/private/test-suite) + rackunit/private/test-suite + syntax/macro-testing) (define (make-failure-test name pred . args) (test-case From 99416ff79af63bbac8de0c7b556a5c016de16c5e Mon Sep 17 00:00:00 2001 From: Tommy McHugh Date: Sun, 3 Jan 2021 16:41:53 -0600 Subject: [PATCH 2/4] created basic tests for check-not-compile-time-exn and check-compile-time-exn --- rackunit-test/tests/rackunit/check-test.rkt | 39 +++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/rackunit-test/tests/rackunit/check-test.rkt b/rackunit-test/tests/rackunit/check-test.rkt index 8451e5e4..16020734 100644 --- a/rackunit-test/tests/rackunit/check-test.rkt +++ b/rackunit-test/tests/rackunit/check-test.rkt @@ -435,6 +435,45 @@ (lambda () (check-not-exn (lambda (x) x))))) + ;; Verify compile time exceptions are now + ;; supported by check-compile-time-exn and + ;; check-not-compile-time-exn + (test-case + "check-compile-time-exn converts compile time exceptions to runtime phase" + (check-compile-time-exn exn:fail:syntax? + (lambda () + (if 1 2)))) + + (test-case "check-compile-time-exn should not evaluate its body" + (define evaluated? (box #f)) + (check-compile-time-exn exn:fail? + (lambda () + (set-box! evaluated? #t) + (define kaboom))) + (check-false (unbox evaluated?))) + + (test-case "check-compile-time-exn expression do not need to be thunks" + (check-compile-time-exn exn:fail? (define))) + + (test-case "check-compile-time-exn accepts regular expression" + (check-compile-time-exn #rx"missing an \"else\" expression" (if 1 2))) + + (test-case + "check-not-compile-time-exn does not call any compile time exceptions when none are provided" + (check-not-compile-time-exn (lambda () + (if 1 2 3)))) + + (test-case "check-not-compile-time-exn should not evaluate its body" + (define evaluated? (box #f)) + (check-not-compile-time-exn + (lambda () + (set-box! evaluated? #t) + (define kaboom 7))) + (check-false (unbox evaluated?))) + + (test-case "check-not-compile-time-exn expression do not need to be thunks" + (check-compile-time-exn exn:fail? (define 7))) + ;; Regression test ;; Uses of check (and derived forms) used to be un-compilable! ;; We check that (write (compile --code-using-check--)) works. From 0bdc05939ce458397b04c0845b23ea06105bcfbf Mon Sep 17 00:00:00 2001 From: Tommy McHugh Date: Sun, 3 Jan 2021 17:38:03 -0600 Subject: [PATCH 3/4] Created documentation for check-compile-time-exn and check-not-compile-time-exn --- rackunit-doc/rackunit/scribblings/check.scrbl | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/rackunit-doc/rackunit/scribblings/check.scrbl b/rackunit-doc/rackunit/scribblings/check.scrbl index 7ed00975..d6bc8baa 100644 --- a/rackunit-doc/rackunit/scribblings/check.scrbl +++ b/rackunit-doc/rackunit/scribblings/check.scrbl @@ -189,6 +189,24 @@ the check fails. } +@defform[(check-compile-time-exn (exn-predicate (or/c (-> any/c any/c) regexp?)) + (expr (-> any))) + void?]{ + +Similar to @racket[check-exn], but checks that an expression, @racket[expr], +raises a runtime or compile time exception and that either @racket[exn-predicate] +returns a true value if it is a function, or that it matches the +message in the exception if @racket[exn-predicate] is a regexp. +In the latter case, the exception raised must be an @racket[exn:fail?]. +} + +@defform[(check-compile-time-exn (expr (-> any))) + void?]{ + +Similar to @racket[check-not-exn], but checks that an expression, @racket[expr], +does not raise a runtime or compile time exception. +} + @defproc[(check-regexp-match (regexp regexp?) (string string?)) void?]{ From 730fe22a6caa346dee753633a0f57a158ccede0f Mon Sep 17 00:00:00 2001 From: Tommy McHugh Date: Mon, 4 Jan 2021 04:39:50 +0000 Subject: [PATCH 4/4] Fixed check-not-compile-time-exn typos --- rackunit-doc/rackunit/scribblings/check.scrbl | 2 +- rackunit-lib/rackunit/private/check.rkt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/rackunit-doc/rackunit/scribblings/check.scrbl b/rackunit-doc/rackunit/scribblings/check.scrbl index d6bc8baa..7f4b1ee5 100644 --- a/rackunit-doc/rackunit/scribblings/check.scrbl +++ b/rackunit-doc/rackunit/scribblings/check.scrbl @@ -200,7 +200,7 @@ message in the exception if @racket[exn-predicate] is a regexp. In the latter case, the exception raised must be an @racket[exn:fail?]. } -@defform[(check-compile-time-exn (expr (-> any))) +@defform[(check-not-compile-time-exn (expr (-> any))) void?]{ Similar to @racket[check-not-exn], but checks that an expression, @racket[expr], diff --git a/rackunit-lib/rackunit/private/check.rkt b/rackunit-lib/rackunit/private/check.rkt index 85e4e079..5d6035fb 100644 --- a/rackunit-lib/rackunit/private/check.rkt +++ b/rackunit-lib/rackunit/private/check.rkt @@ -229,7 +229,7 @@ [(_ expr:expr) #:with loc (datum->syntax #f 'loc stx) #'(let ([location (syntax->location #'loc)]) - (with-check-info (['name 'check-compile-time-exn] + (with-check-info (['name 'check-not-compile-time-exn] ['location location] ['params (list (syntax->datum #'expr))]) (let/ec finish