suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix tests that depend on the current exception handler.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2018-11-18 21:07:15 -05:00
parent b1712b76d1
commit 1ea9ec399f
2 changed files with 35 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
pkgs/racket-test-core/tests/racket/macro.rktl
View File

@ -693,30 +693,32 @@
(parameterize ([current-output-port o]
[current-error-port e]
[current-namespace (make-base-namespace)])
(call-with-continuation-prompt
(lambda ()
(eval
`(module m racket/base
(require (for-syntax racket/base))
(define v 0)
(begin-for-syntax
(struct e (p)
#:property ,prop:macro ,(if (eq? prop:macro 'prop:procedure)
0
(list #'quote-syntax
(syntax-property #'v
'not-free-identifier=?
#t)))
#:property prop:expansion-contexts ',contexts))
(define-syntax m (e (lambda (stx)
(displayln (syntax-local-context))
#'10)))
,(wrap 'm)))
(dynamic-require (if sub? '(submod 'm sub) ''m) #f))))
;; these tests rely on errors printing to the current-error-port
(with-handlers ([exn:fail? (lambda (e) ((error-display-handler) (exn-message e) e))])
(call-with-continuation-prompt
(lambda ()
(eval
`(module m racket/base
(require (for-syntax racket/base))
(define v 0)
(begin-for-syntax
(struct e (p)
#:property ,prop:macro ,(if (eq? prop:macro 'prop:procedure)
0
(list #'quote-syntax
(syntax-property #'v
'not-free-identifier=?
#t)))
#:property prop:expansion-contexts ',contexts))
(define-syntax m (e (lambda (stx)
(displayln (syntax-local-context))
#'10)))
,(wrap 'm)))
(dynamic-require (if sub? '(submod 'm sub) ''m) #f)))))
(list (get-output-string o)
(if error-rx
(let ([m (regexp-match error-rx (get-output-string e))])

16
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -332,12 +332,14 @@
(define (test-i-nan.0 f . args)
(apply test (make-rectangular +nan.0 +nan.0) f args))
(define (test-nan c)
(test #f < +nan.0 c)
(test #f > +nan.0 c)
(test #f = +nan.0 c)
(test #f <= +nan.0 c)
(test #f >= +nan.0 c))
;; these tests are also used as error tests, so provide a way to just call the operation
(define (test-nan c #:test? [test? #t])
(define tst (if test? test (lambda (r c a b) (c a b))))
(tst #f < +nan.0 c)
(tst #f > +nan.0 c)
(tst #f = +nan.0 c)
(tst #f <= +nan.0 c)
(tst #f >= +nan.0 c))
(test-nan 0)
(test-nan 0.0)
(test-nan 0.3)
@ -345,7 +347,7 @@
(test-nan +inf.0)
(test-nan -inf.0)
(test-nan (expt 2 90))
(err/rt-test (test-nan 0.3+0.0i))
(err/rt-test (test-nan 0.3+0.0i #:test? #f))
(test #f = +nan.0 1+2i)
(test #f = +nan.0 (make-rectangular +inf.0 -inf.0))