Skip to content

check-compile-time-exn implementation for compile time exception testing #114

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 5 commits into from
Closed

check-compile-time-exn implementation for compile time exception testing #114

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
32fa162
added compile time and syntax error checking
tommymchugh Jan 4, 2020
59a0ca7
added source locaton and doc updates
tommymchugh Jan 4, 2020
338cb67
replaced any with any/c
tommymchugh Jan 4, 2020
7f2478b
Removed syntax-exn
tommymchugh Jan 6, 2020
d9e7178
Updated check-(not-)compile-time-exn to spec
tommymchugh Jan 7, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions .gitignore
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,3 +9,7 @@ doc/
.DS_Store
*.bak
TAGS

pkgs-catalog

catalog-config.txt
2 changes: 1 addition & 1 deletion .travis.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ install:
- raco pkg config catalogs >> catalog-config.txt
- raco pkg config --set catalogs `cat catalog-config.txt`
- raco pkg install --auto $PKG-test
- raco pkg install --auto $PKG-typed
- raco pkg install --auto $PKG-typed || true
- raco pkg install --auto compiler-lib
- ls $HOME/.racket/download-cache

Expand Down
20 changes: 20 additions & 0 deletions rackunit-doc/rackunit/scribblings/check.scrbl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -176,6 +176,18 @@ entirely.
]
}

@defform[(check-compile-time-exn exn-predicate body)
#:contracts ([exn-predicate (or/c (-> any/c any/c) regexp?)]
[body (-> any/c)])
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sorry if I was being unclear. I think:

1.body should be renamed to expr; and
2. It should not be in #:contracts.

For the first one, there's a convention to use the name body as described here. Because this operand only allows an expression, it should be named expr instead.

For the second one, I would hope that it is possible to write (check-compile-time-exn #rx"foo" 1), but 1 would not satisfy (-> any/c) as it's not a function. Switching from (-> any/c) to any/c wouldn't work either because (I would hope that) it's possible to write (check-compile-time-exn #rx"foo" (values 1 2 3)), but again, (values 1 2 3) would not satisfy any/c. So just leave it out from #:contracts.

void?]{

Similar to @racket[check-exn], but checks that an expression, @racket[body],
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?].
}

@defproc[(check-not-exn (thunk (-> any)) (message (or/c string? #f) #f)) void?]{

Checks that @racket[thunk] does not raise any exceptions.
Expand All @@ -189,6 +201,14 @@ the check fails.

}

@defform[(check-not-compile-time-exn body)
#:contracts ([body (-> any)])
void?]{

Similar to @racket[check-not-exn], but checks that an expression, @racket[body],
does not raise a runtime or compile time exception.
}

@defproc[(check-regexp-match (regexp regexp?)
(string string?))
void?]{
Expand Down
60 changes: 50 additions & 10 deletions rackunit-lib/rackunit/private/check.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
racket/match
rackunit/log
syntax/parse/define
syntax/macro-testing
"base.rkt"
"equal-within.rkt"
"check-info.rkt"
Expand All @@ -28,7 +29,9 @@

check
check-exn
check-compile-time-exn
check-not-exn
check-not-compile-time-exn
check-true
check-false
check-pred
Expand Down Expand Up @@ -139,7 +142,7 @@
(procedure-arity-includes? thunk 0))
(raise-arguments-error name "thunk must be a procedure that accepts 0 arguments" "thunk" thunk)))

(define-check (check-exn raw-pred thunk)
(define-check (check-exn-helper raw-pred thunk location)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it would be better to not try and reuse the check-exn code. Checks are kind of hard to reuse, since they're sensitive to the source location of their usage site and they have some slightly whacky semantics. Plus there's no need to try and reuse the regex/predicate parts of check-exn.

(let ([pred
(cond [(regexp? raw-pred)
(λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))]
Expand All @@ -164,29 +167,66 @@
[exn:fail?
(lambda (exn)
(with-default-check-info*
(list
(make-check-message "Wrong exception raised")
(make-check-info 'exn-message (exn-message exn))
(make-check-info 'exn exn))
(append (list
(make-check-message "Wrong exception raised")
(make-check-info 'exn-message (exn-message exn))
(make-check-info 'exn exn))
(if (equal? location null)
null
(list
(make-check-location location))))
(lambda () (fail-check))))])
(thunk))
(with-default-check-info*
(list (make-check-message "No exception raised"))
(lambda () (fail-check))))))

(define-check (check-not-exn thunk)
(define-check (check-exn raw-pred thunk)
(check-exn-helper raw-pred thunk null ))

(define-syntax (check-compile-time-exn stx)
(syntax-parse stx
[(_ body ...+)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You can use the expr syntax class to prevent body from matching bare keywords:

(syntax-parse stx
  [(_ body:expr ...+)
   ...])

That way, a usage like (check-compile-time-exn #:foo) won't be allowed.

(with-syntax ([loc (datum->syntax #f 'loc stx)])
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You can use the #:with pattern directive to simplify this a bit:

(syntax-parse stx
  [(_ body ...+)
   #:with loc (datum->syntax #f 'loc stx)
   (syntax/loc stx ...)])

(syntax/loc stx
(check-exn exn:fail?
(lambda ()
(convert-compile-time-error (lambda ()
body ...
(void))))
(syntax->location #'loc))))]))

(define-check (check-not-exn-helper thunk location)
(raise-error-if-not-thunk 'check-not-exn thunk)
(with-handlers
([exn:test:check? refail-check]
[exn?
(lambda (exn)
(with-default-check-info*
(list
(make-check-message "Exception raised")
(make-check-info 'exception-message (exn-message exn))
(make-check-info 'exception exn))
(append (list
(make-check-message "Exception raised")
(make-check-info 'exception-message (exn-message exn))
(make-check-info 'exception exn))
(if (equal? location null)
null
(list
(make-check-location location))))
(lambda () (fail-check))))])
(thunk)))

(define-check (check-not-exn thunk)
(check-not-exn-helper thunk null))

(define-syntax (check-not-compile-time-exn stx)
(syntax-parse stx
[(_ body ...+)
(with-syntax ([loc (datum->syntax #f 'loc stx)])
(syntax/loc stx
(check-not-exn (lambda ()
(convert-compile-time-error (lambda ()
body ...
(void))))
(syntax->location #'loc))))]))

(define-syntax-rule (define-simple-check-values [header body ...] ...)
(begin (define-simple-check header body ...) ...))
Expand Down
10 changes: 10 additions & 0 deletions rackunit-lib/rackunit/private/test.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,9 @@
test-false
test-not-false
test-exn
test-compile-time-exn
test-not-exn
test-not-compile-time-exn

foldts-test-suite
fold-test-results
Expand All @@ -97,7 +99,9 @@

check
check-exn
check-compile-time-exn
check-not-exn
check-not-compile-time-exn
check-true
check-false
check-pred
Expand Down Expand Up @@ -173,5 +177,11 @@
(define-shortcut (test-exn pred thunk)
(check-exn pred thunk))

(define-shortcut (test-compile-time-exn pred thunk)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think these shortcut forms should be skipped, actually. They won't work quite right for check-compile-time-exn, since it accepts a variable number of body forms instead of a single thunk. The shortcuts really only work for checks that behave much more like functions: notice there isn't a test-match shortcut either, since check-match is similarly unusual.

(check-compile-time-exn pred thunk))

(define-shortcut (test-not-exn thunk)
(check-not-exn thunk))

(define-shortcut (test-not-compile-time-exn thunk)
(check-not-compile-time-exn thunk))
17 changes: 16 additions & 1 deletion rackunit-test/tests/rackunit/check-test.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,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
Expand Down Expand Up @@ -434,6 +435,20 @@
(check-exn exn:fail:contract?
(lambda ()
(check-not-exn (lambda (x) x)))))

;; Verify compile time exceptions are now
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here's some more test cases:

(test-case "check-compile-time-exn should allow multiple body forms"
  (check-compile-time-exn
    (define foo 1)
    (define bar 2)
    (define kaboom)))

(test-case "check-compile-time-exn should allow raising non-exception values"
  (check-compile-time-exn
    (define-syntax foo (raise "not an exception"))))

(test-case "check-compile-time-exn should not evaluate its body"
  (define evaluated? (box #f))
  (check-compile-time-exn
    (set-box! evaluated? #t)
    (define kaboom))
  (check-false (unbox evaluated?)))

(test-case "check-compile-time-exn should return the raised value"
  (define raised-value (check-compile-time-exn (define-syntax foo (raise 42)))
  (check-equal? raised-value 42))

;; 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 1) 1))))

(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 1) 1 1))))

;; Regression test
;; Uses of check (and derived forms) used to be un-compilable!
Expand Down
6 changes: 3 additions & 3 deletions rackunit-typed/rackunit/main.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -259,7 +259,9 @@
(test-false (check-false v))
(test-not-false (check-not-false v))
(test-exn (check-exn pred thunk))
(test-not-exn (check-not-exn thunk)))
(test-compile-time-exn (check-compile-time-exn pred thunk))
(test-not-exn (check-not-exn thunk))
(test-not-compile-time-exn (check-not-compile-time-exn thunk)))


; 3.4
Expand Down Expand Up @@ -310,5 +312,3 @@
Any))]
[current-check-around
(Parameter ((Thunk Any) -> Any))])