From 53febf19840cc9d34b9c852efc44bbbd4d26d212 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Fri, 2 Feb 2007 02:08:45 +0000 Subject: [PATCH] applied Carl's patches svn: r5539 --- collects/htdp/testing.scm | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/collects/htdp/testing.scm b/collects/htdp/testing.scm index aa3524b1a3..5c07f5a9c5 100644 --- a/collects/htdp/testing.scm +++ b/collects/htdp/testing.scm @@ -47,17 +47,18 @@ (define-syntax (check-expect stx) (syntax-case stx () ((_ test actual) - #`(define #,(gensym 'test) + (quasisyntax/loc stx + (define #,(gensym 'test) (check-values-expected (lambda () test) actual (make-src #,@(list (syntax-source stx) (syntax-line stx) (syntax-column stx) (syntax-position stx) - (syntax-span stx)))))) + (syntax-span stx))))))) ((_ test) - (raise-syntax-error 'check-expect CHECK-EXPECT-STR)) + (raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)) ((_ test actual extra ...) - (raise-syntax-error 'check-expect CHECK-EXPECT-STR)))) + (raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)))) ;check-values-expected: (-> scheme-val) scheme-val src -> void (define (check-values-expected test actual src) @@ -71,19 +72,20 @@ (define-syntax (check-within stx) (syntax-case stx () ((_ test actual within) - #`(define #,(gensym 'test-within) + (quasisyntax/loc stx + (define #,(gensym 'test-within) (check-values-within (lambda () test) actual within (make-src #,@(list (syntax-source stx) (syntax-line stx) (syntax-column stx) (syntax-position stx) - (syntax-span stx)))))) + (syntax-span stx))))))) ((_ test actual) - (raise-syntax-error 'check-within CHECK-WITHIN-STR)) + (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)) ((_ test) - (raise-syntax-error 'check-within CHECK-WITHIN-STR)) + (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)) ((_ test actual within extra ...) - (raise-syntax-error 'check-within CHECK-WITHIN-STR)))) + (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)))) (define (check-values-within test actual within src) (error-check number? within CHECK-WITHIN-INEXACT-FMT) @@ -93,14 +95,15 @@ (define-syntax (check-error stx) (syntax-case stx () ((_ test error) - #`(define #,(gensym 'test-error) + (quasisyntax/loc stx + (define #,(gensym 'test-error) (check-values-error (lambda () test) error (make-src #,@(list (syntax-source stx) (syntax-line stx) (syntax-column stx) (syntax-position stx) - (syntax-span stx)))))) + (syntax-span stx))))))) ((_ test) - (raise-syntax-error 'check-error CHECK-ERROR-STR)))) + (raise-syntax-error 'check-error CHECK-ERROR-STR stx)))) (define (check-values-error test error src) (error-check string? error CHECK-ERROR-STR-FMT) @@ -272,4 +275,4 @@ " column " (number->string (src-col src)))) - ) + ) \ No newline at end of file