7d50e61c7f
* Another big chunk of v4-require-isms * Allow `#lang framework/keybinding-lang' for keybinding files * Move hierlist sources into "mrlib/hierlist", leave stub behind svn: r10689
321 lines
9.8 KiB
Scheme
321 lines
9.8 KiB
Scheme
|
|
#lang scheme/base
|
|
(require "../gentest-framework.ss")
|
|
(provide proto:errors)
|
|
|
|
(define-tests proto:errors "Bad syntax"
|
|
[#:suite
|
|
"Atomic expressions"
|
|
(testKE (#%top a b c)
|
|
#:error-step)
|
|
(testKE (#%top . 5)
|
|
#:error-step)
|
|
(testKE (quote)
|
|
#:error-step)
|
|
(testKE (quote a b)
|
|
#:error-step)
|
|
(testKE (#%require . x)
|
|
#:error-step)
|
|
(testKE (#%require 5)
|
|
#:error-step)
|
|
(testKE (#%require (prefix mzlib/list))
|
|
#:error-step)
|
|
(testKE (#%require (prefix 5 mzlib/list))
|
|
#:error-step)]
|
|
[#:suite
|
|
"Definitions"
|
|
(testKE (define-values x 'a)
|
|
#:error-step)
|
|
(testKE (define-values (x))
|
|
#:error-step)
|
|
(testKE (define-values (x) 'a 'b)
|
|
#:error-step)
|
|
(testKE (define-values (x) . 1)
|
|
#:error-step)
|
|
(testKE (define-values (x x) 1)
|
|
#:error-step)
|
|
(testKE (define-syntaxes x 1)
|
|
#:error-step)
|
|
(testKE (define-syntaxes (x))
|
|
#:error-step)
|
|
(testKE (define-syntaxes (x) 1 2)
|
|
#:error-step)
|
|
(testKE (define-syntaxes (x) . 3)
|
|
#:error-step)
|
|
(testKE (define-syntaxes (x x) 1)
|
|
#:error-step)]
|
|
|
|
;; "Simple expressions"
|
|
[#:suite
|
|
"if misapplied"
|
|
(testKE (if)
|
|
#:error-step)
|
|
(testKE (if 1)
|
|
#:error-step)
|
|
(testKE (if 'a 'b)
|
|
#:error-step)
|
|
(testKE (if 1 2 3 4)
|
|
#:error-step)
|
|
(testKE (if . x)
|
|
#:error-step)
|
|
(testKE (if 1 . x)
|
|
#:error-step)
|
|
(testKE (if 1 2 . x)
|
|
#:error-step)
|
|
(testKE (if 1 2 3 . x)
|
|
#:error-step)]
|
|
[#:suite
|
|
"wcm misapplied"
|
|
(testKE (with-continuation-mark)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 1)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 1 2 3 4)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark . x)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 1 . x)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 1 2 . x)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 1 2 3 . x)
|
|
#:error-step)]
|
|
[#:suite
|
|
"set! misapplied"
|
|
(testKE (set!)
|
|
#:error-step)
|
|
(testKE (set! x)
|
|
#:error-step)
|
|
(testKE (set! x . 3)
|
|
#:error-step)
|
|
(testKE (set! x 1 2)
|
|
#:error-step)
|
|
(testKE (set! 1)
|
|
#:error-step)
|
|
(testKE (set! 1 2)
|
|
#:error-step)]
|
|
|
|
;; "Sequence-containing expressions"
|
|
[#:suite
|
|
"begin misapplied"
|
|
(testKE (#%expression (begin))
|
|
#:error-step)
|
|
(testKE (begin . 1)
|
|
#:error-step)
|
|
(testKE (begin 'a . 2)
|
|
#:error-step)]
|
|
[#:suite
|
|
"begin0 misapplied"
|
|
(testKE (begin0)
|
|
#:error-step)
|
|
(testKE (begin0 . 1)
|
|
#:error-step)
|
|
(testKE (begin0 'a . 2)
|
|
#:error-step)
|
|
(testKE (begin0 'a 'b . 3)
|
|
#:error-step)]
|
|
[#:suite
|
|
"#%app (implicit) misapplied"
|
|
(testKE (+ . 1)
|
|
[#:steps (tag-app (#%app + . 1))
|
|
error])
|
|
(testKE (+ 1 . 2)
|
|
[#:steps (tag-app (#%app + 1 . 2))
|
|
error])
|
|
(testKE (+ 1 2 . 3)
|
|
[#:steps (tag-app (#%app + 1 2 . 3))
|
|
error])]
|
|
[#:suite
|
|
"#%app (explicit) misapplied"
|
|
(testKE (#%app . +)
|
|
#:error-step)
|
|
(testKE (#%app + . 1)
|
|
#:error-step)
|
|
(testKE (#%app + 1 . 2)
|
|
#:error-step)
|
|
(testKE (#%app + 1 2 . 3)
|
|
#:error-step)]
|
|
|
|
;; "Binding forms"
|
|
[#:suite
|
|
"lambda misapplied"
|
|
(testKE (lambda)
|
|
#:error-step)
|
|
(testKE (lambda args)
|
|
#:error-step)
|
|
(testKE (lambda #(a b) 1)
|
|
#:error-step)
|
|
(testKE (lambda args . 1)
|
|
#:error-step)
|
|
(testKE (lambda 1 2)
|
|
#:error-step)
|
|
(testKE (lambda (1) 2)
|
|
#:error-step)
|
|
(testKE (lambda (x . 1) 2)
|
|
#:error-step)
|
|
(testKE (lambda (x x) 1)
|
|
#:error-step)
|
|
(testKE (lambda (x y x) 1)
|
|
#:error-step)]
|
|
[#:suite
|
|
"letrec-values misapplied"
|
|
(testKE (letrec-values)
|
|
#:error-step)
|
|
(testKE (letrec-values x)
|
|
#:error-step)
|
|
(testKE (letrec-values x 1)
|
|
#:error-step)
|
|
(testKE (letrec-values (x) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values (x 1) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values ([x 1]) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values ([(x . y) 1]) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values ([(x) 1 2]) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values ([(x) 1] x) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values ([(x) 1] [y 2]) 3)
|
|
#:error-step)
|
|
(testKE (letrec-values ([(x x) 1]) 2)
|
|
#:error-step)
|
|
(testKE (letrec-values ([(x) 1] [(x) 2]) 3)
|
|
#:error-step)]
|
|
|
|
[#:suite
|
|
"Internal definitions"
|
|
[#:suite
|
|
"Basic internal definitions"
|
|
(testKE (lambda () . 1) ;; FIXME
|
|
#:error-step)
|
|
(testKE (lambda () (begin))
|
|
[#:steps (rename-lambda (lambda () (begin)))
|
|
(splice-block (lambda ()))
|
|
error])
|
|
(testKE (lambda () (define-values (x) 1))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x) 1) . 2)
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (begin (define-values (x) 1) . 2))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (begin (define-values (x) 1) . 2) 3)
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda ()
|
|
(define-values (x) 1)
|
|
(define-values (x) 2)
|
|
3)
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda (x)
|
|
(define-values (x) 'a)
|
|
'b
|
|
(define-values (y) 'c)
|
|
'd)
|
|
[#:steps (rename-lambda (lambda (x)
|
|
(define-values (x) 'a)
|
|
'b
|
|
(define-values (y) 'c)
|
|
'd))
|
|
(block->letrec (lambda (x)
|
|
(letrec-values ([(x) 'a])
|
|
'b
|
|
(define-values (y) 'c)
|
|
'd)))
|
|
(rename-letrec-values (lambda (x)
|
|
(letrec-values ([(x) 'a])
|
|
'b
|
|
(define-values (y) 'c)
|
|
'd)))
|
|
error])]
|
|
[#:suite
|
|
"bad internal begin"
|
|
(testKE (lambda () (begin . 1))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (begin 1 . 2))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x) 1) (begin . 2))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x) 1) (begin 1 . 2))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x) 1) (begin . 2) 3)
|
|
[#:rename+error-step rename-lambda])]
|
|
[#:suite
|
|
"bad definition forms"
|
|
(testKE (lambda () (define-values))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values x))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values x 1))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x . y) 1))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x) . 1))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x) 1 2))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values (x x) 1))
|
|
[#:rename+error-step rename-lambda])]]
|
|
[#:suite
|
|
"Errors in primitive contexts"
|
|
[#:suite
|
|
"Definitions"
|
|
(testKE (define-syntaxes (x) (lambda))
|
|
#:error-step)
|
|
(testKE (define-values (x) (wrong))
|
|
#:error-step)]
|
|
[#:suite
|
|
"Simple expressions"
|
|
(testKE (if (wrong) 'b 'c)
|
|
#:error-step)
|
|
(testKE (if 'a (wrong) 'c)
|
|
#:error-step)
|
|
(testKE (if 'a 'b (wrong))
|
|
#:error-step)
|
|
(testKE (if (wrong) 'b)
|
|
#:error-step)
|
|
(testKE (if 'a (wrong))
|
|
#:error-step)
|
|
(testKE (with-continuation-mark (wrong) 'b 'c)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 'a (wrong) 'c)
|
|
#:error-step)
|
|
(testKE (with-continuation-mark 'a 'b (wrong))
|
|
#:error-step)
|
|
(testKE (set! x (wrong))
|
|
#:error-step)]
|
|
[#:suite
|
|
"Sequence-containing expressions"
|
|
(testKE (begin (wrong))
|
|
#:error-step)
|
|
(testKE (begin 'a (wrong))
|
|
#:error-step)
|
|
(testKE (begin0 (wrong))
|
|
#:error-step)
|
|
(testKE (begin0 'a (wrong))
|
|
#:error-step)
|
|
(testKE (#%app (wrong))
|
|
#:error-step)
|
|
(testKE (#%app + (wrong))
|
|
#:error-step)]
|
|
[#:suite
|
|
"Binding forms"
|
|
(testKE (lambda (x) (begin0 (wrong)))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (letrec-values ([(x) (wrong)]) 1)
|
|
[#:rename+error-step rename-letrec-values])
|
|
(testKE (letrec-values ([(x) 'a]) (begin0 (wrong)))
|
|
[#:rename+error-step rename-letrec-values])]
|
|
[#:suite
|
|
"Internal definitions"
|
|
(testKE (lambda () (wrong))
|
|
[#:rename+error-step rename-lambda])
|
|
(testKE (lambda () (define-values () (wrong)) 1)
|
|
[#:steps
|
|
(rename-lambda (lambda () (define-values () (wrong)) 1))
|
|
(block->letrec (lambda () (letrec-values ([() (wrong)]) 1)))
|
|
(rename-letrec-values (lambda () (letrec-values ([() (wrong)]) 1)))
|
|
error])
|
|
(testKE (lambda () (define-values (x) 1) (wrong))
|
|
[#:rename+error-step rename-lambda])]])
|