add a bunch of tests to the module language test suite based on test cases in the repl test suite
(since the repl test suite tests the pretty big language's repl and since there was a test case there that would have discovered a bug that we only found in the hours before the release but had been lurking for a few days)
This commit is contained in:
Robby Findler
parent
43e421faf4
commit
961e280a98
|
|
@ -1,5 +1,5 @@
|
|||
#lang at-exp racket/gui
|
||||
(require "module-lang-test-utils.rkt")
|
||||
(require "private/module-lang-test-utils.rkt")
|
||||
(provide run-test)
|
||||
|
||||
;; set up for tests that need external files
|
||||
|
|
@ -164,8 +164,7 @@
|
|||
|
||||
(test @t{#lang racket}
|
||||
@t{(begin-for-syntax (+ 1 2))}
|
||||
@t{> (begin-for-syntax (+ 1 2))}
|
||||
#t)
|
||||
@t{})
|
||||
|
||||
(test @t{#lang racket}
|
||||
@t{(begin (struct s (x)) (struct t s (y)) (s-x (t 1 2)))}
|
||||
|
|
@ -255,6 +254,112 @@
|
|||
" (f)")
|
||||
#t)
|
||||
|
||||
(test @t{#lang racket/base}
|
||||
@t{(begin (values) 1)}
|
||||
"1")
|
||||
|
||||
(test @t{#lang racket/base}
|
||||
@t{ (eval '(values 1 2))}
|
||||
@t{1@"\n"2})
|
||||
(test @t{#lang racket/base}
|
||||
@t{ (eval '(list 1 2))}
|
||||
@t{'(1 2)})
|
||||
(test @t{#lang racket/base}
|
||||
@t{ (eval '(lambda ()))}
|
||||
@t{lambda: bad syntax in: (lambda ())})
|
||||
(test @t{#lang racket/base}
|
||||
@t{(expt 3 (void))}
|
||||
@rx{expt: expected argument of type <number>; given #<void>})
|
||||
(test @t{#lang racket/base}
|
||||
@t{1 2 ( 3 4}
|
||||
@t{1@"\n"2@"\n". read: expected a `)' to close `('})
|
||||
(test @t{#lang racket/base}
|
||||
"1 2 . 3 4"
|
||||
"1\n2\n. read: illegal use of \".\"")
|
||||
(test @t{#lang racket/base}
|
||||
"1 2 (lambda ()) 3 4"
|
||||
"1\n2\n. lambda: bad syntax in: (lambda ())")
|
||||
(test @t{#lang racket/base}
|
||||
"1 2 x 3 4"
|
||||
"1\n2\n. . reference to an identifier before its definition: x")
|
||||
(test @t{#lang racket/base}
|
||||
"1 2 (raise 1) 3 4"
|
||||
"1\n2\nuncaught exception: 1")
|
||||
(test @t{#lang racket/base}
|
||||
"1 2 (raise #f) 3 4"
|
||||
"1\n2\nuncaught exception: #f")
|
||||
(test @t{#lang racket/base}
|
||||
"(current-namespace (make-empty-namespace)) if"
|
||||
". compile: unbound identifier (and no #%app syntax transformer is bound) in: #%top-interaction")
|
||||
(test @t{#lang racket/base}
|
||||
(string-append
|
||||
"(let ([old (error-escape-handler)])\n"
|
||||
"(+ (let/ec k\n(dynamic-wind\n"
|
||||
"(lambda () (error-escape-handler (lambda () (k 5))))\n"
|
||||
"(lambda () (expt 3 #f))\n"
|
||||
"(lambda () (error-escape-handler old))))\n"
|
||||
"10))")
|
||||
". . expt: expected argument of type <number>; given #f\n15")
|
||||
(test @t{#lang racket/base}
|
||||
"(write (list (syntax x)))"
|
||||
"(.)")
|
||||
(test @t{#lang racket/base}
|
||||
"(parameterize ([current-output-port (open-output-string)]) (write #'1))"
|
||||
"")
|
||||
(test @t{#lang racket/base}
|
||||
"(write-special 1)"
|
||||
"1#t")
|
||||
(test @t{#lang racket/gui}
|
||||
(format "~s ~s ~s"
|
||||
'(define s (make-semaphore 0))
|
||||
'(queue-callback
|
||||
(lambda ()
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda () (expt 3 #f))
|
||||
(lambda () (semaphore-post s)))))
|
||||
'(begin (yield s) (void)))
|
||||
". . expt: expected argument of type <number>; given #f")
|
||||
(test @t{#lang racket/base}
|
||||
(format "~s ~s"
|
||||
'(define x 1)
|
||||
'((λ (x y) y) (set! x (call/cc (lambda (x) x))) (x 3)))
|
||||
". . procedure application: expected procedure, given: 3; arguments were: 3")
|
||||
(test @t{#lang racket/base}
|
||||
(format "~s ~s ~s ~s"
|
||||
'(begin (define k (call/cc (λ (x) x)))
|
||||
(define x 'wrong))
|
||||
'(set! x 'right)
|
||||
'(k 1)
|
||||
'x)
|
||||
"'right")
|
||||
(test @t{#lang racket/base}
|
||||
(format "~s"
|
||||
'(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(eval '(begin (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
1 2 3)
|
||||
10)))
|
||||
(default-continuation-prompt-tag)
|
||||
list))
|
||||
"'(1 2 3)")
|
||||
(test @t{#lang racket/gui}
|
||||
"(vector (new snip%))"
|
||||
"(vector .)")
|
||||
(test @t{#lang racket/base}
|
||||
"(begin (thread (lambda () x)) (sleep 1/10))"
|
||||
". . reference to an identifier before its definition: x")
|
||||
(test @t{#lang racket/base}
|
||||
"(require texpict/utils)(disk 3)"
|
||||
".")
|
||||
(test @t{#lang racket/base}
|
||||
(string-append
|
||||
"(require mzlib/pretty)"
|
||||
"(pretty-print-print-hook (lambda x (expt 3 #f)))"
|
||||
"(list 1 2 3)")
|
||||
"'(1 2 3)")
|
||||
|
||||
;; test protection against user-code changing the namespace
|
||||
(test @t{#lang racket/base
|
||||
(current-namespace (make-base-namespace))}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
#lang scheme/gui
|
||||
(require "private/drracket-test-util.rkt" mzlib/etc framework scheme/string)
|
||||
#lang racket/gui
|
||||
(require "drracket-test-util.rkt"
|
||||
mzlib/etc
|
||||
framework
|
||||
racket/string)
|
||||
|
||||
(provide test t rx run-test in-here write-test-modules)
|
||||
|
||||
|
|
@ -65,73 +68,80 @@
|
|||
(clear-definitions drs)
|
||||
(insert-in-definitions drs (test-definitions test))
|
||||
(do-execute drs)
|
||||
|
||||
(let ([ints (test-interactions test)])
|
||||
|
||||
(when ints
|
||||
(let ([after-execute-output
|
||||
(queue-callback/res
|
||||
(λ ()
|
||||
(send interactions-text
|
||||
get-text
|
||||
(send interactions-text paragraph-start-position 2)
|
||||
(send interactions-text paragraph-end-position 2))))])
|
||||
(unless (or (test-all? test) (string=? "> " after-execute-output))
|
||||
(fprintf (current-error-port)
|
||||
"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)
|
||||
(k (void)))
|
||||
(type-in-interactions drs ints)
|
||||
(test:keystroke #\return)
|
||||
(wait-for-computation drs)))
|
||||
|
||||
(let* ([text
|
||||
(queue-callback/res
|
||||
(λ ()
|
||||
(if (test-all? test)
|
||||
(let* ([para (- (send interactions-text position-paragraph
|
||||
(send interactions-text last-position))
|
||||
1)])
|
||||
(send interactions-text
|
||||
get-text
|
||||
(send interactions-text paragraph-start-position 2)
|
||||
(send interactions-text paragraph-end-position para)))
|
||||
(let* ([para (- (send interactions-text position-paragraph
|
||||
(send interactions-text last-position))
|
||||
1)])
|
||||
(send interactions-text
|
||||
get-text
|
||||
(send interactions-text paragraph-start-position para)
|
||||
(send interactions-text paragraph-end-position para))))))]
|
||||
[output-passed? (let ([r (test-result test)])
|
||||
((cond [(string? r) string=?]
|
||||
[(regexp? r) regexp-match?]
|
||||
[else 'module-lang-test "bad test value: ~e" r])
|
||||
r text))])
|
||||
(unless output-passed?
|
||||
|
||||
(define ints (test-interactions test))
|
||||
|
||||
(define output-start-paragraph 2)
|
||||
|
||||
(when ints
|
||||
(let ([after-execute-output
|
||||
(queue-callback/res
|
||||
(λ ()
|
||||
(send interactions-text
|
||||
get-text
|
||||
(send interactions-text paragraph-start-position 2)
|
||||
(send interactions-text paragraph-end-position 2))))])
|
||||
(unless (or (test-all? test) (string=? "> " after-execute-output))
|
||||
(fprintf (current-error-port)
|
||||
"FAILED (line ~a): ~a\n ~a\n expected: ~s\n got: ~s\n"
|
||||
"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)
|
||||
(test-result test)
|
||||
text))
|
||||
(cond
|
||||
[(eq? (test-error-ranges test) 'dont-test)
|
||||
(void)]
|
||||
[else
|
||||
(let ([error-ranges-expected
|
||||
((test-error-ranges test) definitions-text interactions-text)])
|
||||
(unless (equal? error-ranges-expected (send interactions-text get-error-ranges))
|
||||
(fprintf (current-error-port)
|
||||
"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))))])))))
|
||||
after-execute-output)
|
||||
(k (void)))
|
||||
(type-in-interactions drs ints)
|
||||
;; set to be the paragraph right after the insertion.
|
||||
(set! output-start-paragraph
|
||||
(queue-callback/res
|
||||
(λ () (+ (send interactions-text position-paragraph
|
||||
(send interactions-text last-position))
|
||||
1))))
|
||||
(test:keystroke #\return '(alt))
|
||||
(wait-for-computation drs)))
|
||||
|
||||
(define text
|
||||
(queue-callback/res
|
||||
(λ ()
|
||||
(define para-before-prompt
|
||||
(- (send interactions-text position-paragraph
|
||||
(send interactions-text last-position))
|
||||
1))
|
||||
(if (test-all? test)
|
||||
(send interactions-text
|
||||
get-text
|
||||
(send interactions-text paragraph-start-position 2)
|
||||
(send interactions-text paragraph-end-position para-before-prompt))
|
||||
(send interactions-text
|
||||
get-text
|
||||
(send interactions-text paragraph-start-position output-start-paragraph)
|
||||
(send interactions-text paragraph-end-position para-before-prompt))))))
|
||||
(define output-passed?
|
||||
(let ([r (test-result test)])
|
||||
((cond [(string? r) string=?]
|
||||
[(regexp? r) regexp-match?]
|
||||
[else 'module-lang-test "bad test value: ~e" r])
|
||||
r text)))
|
||||
(unless output-passed?
|
||||
(fprintf (current-error-port)
|
||||
"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)
|
||||
text))
|
||||
(cond
|
||||
[(eq? (test-error-ranges test) 'dont-test)
|
||||
(void)]
|
||||
[else
|
||||
(let ([error-ranges-expected
|
||||
((test-error-ranges test) definitions-text interactions-text)])
|
||||
(unless (equal? error-ranges-expected (send interactions-text get-error-ranges))
|
||||
(fprintf (current-error-port)
|
||||
"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))))])))
|
||||
|
||||
(define drs 'not-yet-drs-frame)
|
||||
(define interactions-text 'not-yet-interactions-text)
|
||||
Loading…
Reference in New Issue
Block a user