ref: ef5efcbbf1c2d775433867d7ed00b206a0e95dad
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")