ref: 46745c5e5cf56cc496fe35609ad50d76f9c57235
dir: /tests/form-common.zuo/
#lang zuo/datum (check 1 1) (check cons cons) (check-fail oops "unbound identifier: oops") (check (cons 1 2) '(1 . 2)) (check-fail (cons 1 . 2) bad-stx) (check-fail (cons . 2) bad-stx) (check (procedure? (lambda (x) x)) #t) (check (procedure? (lambda (x y) x)) #t) (check (procedure? (lambda (x y . z) x)) #t) (check (procedure? (lambda (x y . z) x x)) #t) (check (procedure? (lambda (x [y x] . z) x x)) #t) (check-fail (lambda) bad-stx) (check-fail (lambda . x) bad-stx) (check-fail (lambda 5 x) bad-stx) (check-fail (lambda (x x) x) "duplicate identifier") (check-fail (lambda (x . x) x) "duplicate identifier") (check-fail (lambda (x y x) x) "duplicate identifier") (check-fail (lambda (x y . x) x) "duplicate identifier") (check-fail (lambda (x y . z) . x) bad-stx) (check-fail (lambda (x y . 5) x) bad-stx) (check-fail (lambda ([x 1] y . z) x) bad-stx) (check-fail (lambda (x [y . 1] . z) x) bad-stx) (check-fail (lambda (x [y 1 2] . z) x) bad-stx) (check-fail (lambda 5 x) bad-stx) (check-fail (lambda x 1 . 2) bad-stx) (check-fail (lambda x 1 2 . 3) bad-stx) (check-fail lambda bad-stx) (check ((lambda (x y z) (list z x)) 1 2 3) '(3 1)) (check ((lambda (x y [z (+ x y)]) (list z x)) 1 2 30) '(30 1)) (check ((lambda (x y [z (+ x y)]) (list z x)) 1 2) '(3 1)) (check ((lambda (x [y (+ x 2)] [z (+ x y)]) (list z x)) 1) '(4 1)) (check-fail ((lambda (x) x)) arity) (check-fail ((lambda (x) x) 1 2) arity) (check-fail ((lambda (x . z) x)) arity) (check (procedure? (lambda (x) x)) #t) (check (quote cons) 'cons) (check-fail (quote) bad-stx) (check-fail (quote cons list) bad-stx) (check-fail (quote . cons) bad-stx) (check-fail (quote cons . list) bad-stx) (check-fail quote bad-stx) (check (if #t 1 2) 1) (check (if 0 1 2) 1) (check (if #f 1 2) 2) (check-fail (if) bad-stx) (check-fail (if . 1) bad-stx) (check-fail (if 1) bad-stx) (check-fail (if 1 . 2) bad-stx) (check-fail (if 1 2) bad-stx) (check-fail (if 1 2 . 3) bad-stx) (check-fail (if 1 2 3 . 4) bad-stx) (check-fail (if 1 2 3 4) bad-stx) (check-fail if bad-stx) (check (let ([x 1]) x) 1) (check (let ([x 1]) (let ([x 2]) x)) 2) (check (let ([x 1]) (list (let ([x 2]) x) x)) '(2 1)) (check (let ([x 1] [y 2]) (let ([x y] [y x]) (list y x))) '(1 2)) (check (let* ([x 1]) x) 1) (check (let* ([x 1]) (let ([x 2]) x)) 2) (check (let* ([x 1]) (list (let* ([x 2]) x) x)) '(2 1)) (check (let* ([x 1] [y 2]) (let* ([x y] [y x]) (list y x))) '(2 2)) (check (letrec ([x 1]) x) 1) (check (letrec ([x 1]) (let ([x 2]) x)) 2) (check (letrec ([x 1]) (list (letrec ([x 2]) x) x)) '(2 1)) (check-fail (letrec ([x y] [y x]) (list y x)) "undefined") (define (check-bad-lets let-id) (check-fail (,let-id) bad-stx) (check-fail (,let-id . x) bad-stx) (check-fail (,let-id ()) bad-stx) (check-fail (,let-id (x) x) bad-stx) (check-fail (,let-id ([x]) x) bad-stx) (check-fail (,let-id ([x . 1]) x) bad-stx) (check-fail (,let-id ([x 1 . 2]) x) bad-stx) (check-fail (,let-id ([x 1 2]) x) bad-stx) (check-fail (,let-id ([1 2]) x) bad-stx) (check-fail (,let-id ([x 2] . y) x) bad-stx) (check-fail (,let-id ([x 2] y) x) bad-stx) (check-fail (,let-id ([x 2])) bad-stx) (check-fail (,let-id ([x 2]) . x) bad-stx) (check-fail (,let-id ([x 2]) x . x) bad-stx) (check-fail (,let-id ([x 2]) x x . x) bad-stx) (check-fail ,let-id bad-stx)) (check-bad-lets 'let) (check-bad-lets 'letrec) (check-bad-lets 'let*) (check (begin 1) 1) (check (begin 1 2) 2) (check (begin 1 2 3 4) 4) (check-fail (list (begin)) bad-stx) (check-fail (begin . 1) bad-stx) (check-fail (begin 1 2 3 . 4) bad-stx) (check-fail begin bad-stx) (check (and) #t) (check (and 1) 1) (check (and 1 2) 2) (check (and #f (quotient 1 0)) #f) (check-fail and bad-stx) (check-fail (and . 1) bad-stx) (check-fail (and 1 . 2) bad-stx) (check (or) #f) (check (or 1) 1) (check (or 1 2) 1) (check (or #f 2) 2) (check (or #t (quotient 1 0)) #t) (check-fail or bad-stx) (check-fail (or . 1) bad-stx) (check-fail (or 1 . 2) bad-stx) (check (when 1 2) 2) (check (when 1 2 3) 3) (check (when #f 2) (void)) (check-fail when bad-stx) (check-fail (when . #t) bad-stx) (check-fail (when #t) bad-stx) (check-fail (when #t . 1) bad-stx) (check (unless 1 2) (void)) (check (unless #f 2 3) 3) (check (unless #f 2) 2) (check-fail unless bad-stx) (check-fail (unless . #t) bad-stx) (check-fail (unless #t) bad-stx) (check-fail (unless #t . 1) bad-stx) (check (cond) (void)) (check (cond [1 2]) 2) (check (cond [else 2]) 2) (check (cond [#f 2]) (void)) (check (cond [#f 2] [#t 'ok]) 'ok) (check (cond [#f 2] [else 'ok]) 'ok) (check (cond [#f 1 2] [else 'yes 'ok]) 'ok) (check (cond [#t 1 2] [else 'yes 'ok]) 2) (check-fail cond bad-stx) (check-fail (cond . 1) bad-stx) (check-fail (cond []) bad-stx) (check-fail (cond [1]) bad-stx) (check-fail (cond [1 . 2]) bad-stx) (check-fail (cond [1 2] . 5) bad-stx) (check-fail (cond [else 2] [else 10]) "misplaced syntax") (check-fail else "misplaced syntax") (check `x 'x) (check `1 1) (check `() '()) (check `((1 (#t x))) '((1 (#t x)))) (check `,(+ 1 1) 2) (check `(1 ,(+ 1 1) 3) '(1 2 3)) (check `(1 `,(+ 1 1) 3) '(1 `,(+ 1 1) 3)) (check `(1 `,,(+ 1 1) 3) '(1 `,2 3)) (check `(1 `,(0 . ,(+ 1 1)) 3) '(1 `,(0 . 2) 3)) (check `(1 ,@(list 2 3) 4) '(1 2 3 4)) (check `(,@(list 2 3) 4) '(2 3 4)) (check `(,@(list 2 3) . 4) '(2 3 . 4)) (check `(1 ,@4) '(1 . 4)) (check `unquote 'unquote) (check `(1 . unquote) '(1 . unquote)) (check-fail* 'unquote #f "misplaced syntax") (check-fail* 'unquote-splicing #f "misplaced syntax") (check-fail* '`(1 . ,@(list 2 3)) #f "misplaced splicing unquote") (check (module-path? (quote-module-path))) (check (pair? (member (cdr (split-path (quote-module-path))) '("form.zuo" "form-hygienic.zuo")))) (define (reverse-rest x . y) (cons x (reverse y))) (check (reverse-rest 1 2 3) '(1 3 2)) (define (combiner x [y (+ x 2)] [z (+ x y)] . rest) (list z x rest)) (check (combiner 1) '(4 1 ())) (check (combiner 1 10 20 30 40) '(20 1 (30 40))) (define (check-bad-defines define-id) (check-fail ,define-id bad-stx) (check-fail (,define-id) bad-stx) (check-fail (,define-id . x) bad-stx) (check-fail (,define-id x) bad-stx) (check-fail (,define-id x 1 2) bad-stx) (check-fail (,define-id x . 1) bad-stx) (check-fail (,define-id x 1 . 2) bad-stx) (check-fail (,define-id 1 1) bad-stx) (check-fail (,define-id (x)) bad-stx) (check-fail (,define-id (x) . 1) bad-stx) (check-fail (,define-id (x) 1 . 2) bad-stx) (check-fail (,define-id (1) 1) bad-stx) (check-fail (,define-id (x . 1) 1) bad-stx) (check-fail (,define-id (x 1) 1) bad-stx) (check-fail (,define-id (x [y]) 1) bad-stx) (check-fail (,define-id (x [y 1 2]) 1) bad-stx) (check-fail (,define-id (x [y . 1]) 1) bad-stx) (check-fail (,define-id ([y 1] x) 1) bad-stx)) (check-bad-defines 'define) (check-bad-defines 'define-syntax) (define bad-macro "not a procedure or context consumer") (check-fail (define-syntax whatever 19) "not a procedure or context consumer") (check-fail (context-consumer 19) "not a procedure")