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

fixed up some of the platform inconsistencies

Browse Source 
svn: r12129
This commit is contained in:
Robby Findler 2008-10-25 20:35:09 +00:00
parent f902850a52
commit e7aef55f74
2 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/tests/drscheme/module-lang-test-utils.ss
View File

@ -12,32 +12,39 @@
interactions ; (union #f string)
result ; string
all? ; boolean (#t => compare all of the text between the 3rd and n-1-st line)
error-ranges) ; (or/c 'dont-test
error-ranges ; (or/c 'dont-test
; (-> (is-a?/c text)
; (is-a?/c text)
; (or/c #f (listof ...))))
; fn => called with defs & ints, result must match get-error-ranges method's result
line) ; number or #f: the line number of the test case
#:omit-define-syntaxes)
(define in-here
(let ([here (this-expression-source-directory)])
(lambda (file) (path->string (build-path here file)))))
(lambda (file) (format "~s" (path->string (build-path here file))))))
(define tests '())
(define (test definitions interactions results [all? #f] #:error-ranges [error-ranges 'dont-test])
(define-syntax (test stx)
(syntax-case stx ()
[(_ args ...)
(with-syntax ([line (syntax-line stx)])
#'(test/proc line args ...))]))
(define (test/proc line definitions interactions results [all? #f] #:error-ranges [error-ranges 'dont-test])
(set! tests (cons (make-test (if (string? definitions)
definitions
(format "~s" definitions))
interactions
results
all?
error-ranges)
error-ranges
line)
tests)))
(define temp-files '())
(define (write-test-modules* name code)
(let ([file (in-here (format "~a.ss" name))])
(let ([file (build-path (this-expression-source-directory) (format "~a.ss" name))])
(set! temp-files (cons file temp-files))
(with-output-to-file file #:exists 'truncate
(lambda () (printf "~s\n" code)))))
@ -65,7 +72,8 @@
(send interactions-text paragraph-start-position 2)
(send interactions-text paragraph-end-position 2))])
(unless (or (test-all? test) (string=? "> " after-execute-output))
(printf "FAILED: ~a\n ~a\n expected no output after execution, got: ~s\n"
(printf "FAILED (line ~a): ~a\n ~a\n expected no output after execution, got: ~s\n"
(test-line test)
(test-definitions test)
(or (test-interactions test) 'no-interactions)
after-execute-output)
@ -96,7 +104,8 @@
[else 'module-lang-test "bad test value: ~e" r])
r text))])
(unless output-passed?
(printf "FAILED: ~a\n ~a\n expected: ~s\n got: ~s\n"
(printf "FAILED (line ~a): ~a\n ~a\n expected: ~s\n got: ~s\n"
(test-line test)
(test-definitions test)
(or (test-interactions test) 'no-interactions)
(test-result test)
@ -108,7 +117,8 @@
(let ([error-ranges-expected
((test-error-ranges test) definitions-text interactions-text)])
(unless (equal? error-ranges-expected (send interactions-text get-error-ranges))
(printf "FAILED (ranges): ~a\n expected: ~s\n got: ~s\n"
(printf "FAILED (line ~a; ranges): ~a\n expected: ~s\n got: ~s\n"
(test-line test)
(test-definitions test)
error-ranges-expected
(send interactions-text get-error-ranges))))])))))

12
collects/tests/drscheme/module-lang-test.ss
View File

@ -98,11 +98,11 @@
(require (prefix x: (lib "list.ss")) (lib "list.ss")))}
@t{x:foldl}
#rx"foldl>")
(test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") x)}
(test @t{(module m (file @in-here{module-lang-test-tmp1.ss}) x)}
@t{x}
"1")
;; + shouldn't be bound in the REPL because it isn't bound in the module.
(test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") x)}
(test @t{(module m (file @in-here{module-lang-test-tmp1.ss}) x)}
@t{+}
". . reference to an identifier before its definition: +")
(test @t{(module m mzscheme (provide lambda))}
@ -138,7 +138,7 @@
@t{a}
"78")
(test @t{(module m mzscheme
(require-for-syntax (file "@in-here{module-lang-test-tmp2.ss}"))
(require-for-syntax (file @in-here{module-lang-test-tmp2.ss}))
(provide s)
(define-syntax (s stx) e))}
@t{(require m) s}
@ -160,7 +160,7 @@
#f
@rx{. compile: bad syntax; reference to top-level identifier is not
allowed, because no #%top syntax transformer is bound in: cons})
(test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") 1 2 3)}
(test @t{(module m (file @in-here{module-lang-test-tmp1.ss}) 1 2 3)}
@t{1} ;; just make sure no errors.
"1")
@ -195,7 +195,7 @@
Interactions disabled:
does not support a REPL \(no #%top-interaction\)}
#t)
(test @t{(module xx (file "@in-here{module-lang-test-tmp4.ss}")
(test @t{(module xx (file @in-here{module-lang-test-tmp4.ss})
(define x 1)
(* x 123))}
#f
@ -205,7 +205,7 @@
does not support a REPL \(no #%top-interaction\)
}
#t)
(test @t{(module xx (file "@in-here{this-file-does-not-exist}")
(test @t{(module xx (file @in-here{this-file-does-not-exist})
(define x 1)
(* x 123))}
#f