mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 12:20:26 +02:00
4dce3c9645
providing bad syntax. Otherwise, the memoizer will report an error immediately after reading the form, without even the chance to get the pass-if-exception mechanism started.
552 lines
13 KiB
Scheme
552 lines
13 KiB
Scheme
;;;; syntax.test --- test suite for Guile's syntactic forms -*- scheme -*-
|
|
;;;;
|
|
;;;; Copyright (C) 2001 Free Software Foundation, Inc.
|
|
;;;;
|
|
;;;; This program is free software; you can redistribute it and/or modify
|
|
;;;; it under the terms of the GNU General Public License as published by
|
|
;;;; the Free Software Foundation; either version 2, or (at your option)
|
|
;;;; any later version.
|
|
;;;;
|
|
;;;; This program is distributed in the hope that it will be useful,
|
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;;; GNU General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU General Public License
|
|
;;;; along with this software; see the file COPYING. If not, write to
|
|
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
;;;; Boston, MA 02111-1307 USA
|
|
|
|
|
|
(define exception:bad-bindings
|
|
(cons 'misc-error "^bad bindings"))
|
|
(define exception:duplicate-bindings
|
|
(cons 'misc-error "^duplicate bindings"))
|
|
(define exception:bad-body
|
|
(cons 'misc-error "^bad body"))
|
|
(define exception:bad-formals
|
|
(cons 'misc-error "^bad formals"))
|
|
(define exception:duplicate-formals
|
|
(cons 'misc-error "^duplicate formals"))
|
|
(define exception:bad-var
|
|
(cons 'misc-error "^bad variable"))
|
|
(define exception:bad/missing-clauses
|
|
(cons 'misc-error "^bad or missing clauses"))
|
|
(define exception:missing/extra-expr
|
|
(cons 'misc-error "^missing or extra expression"))
|
|
|
|
|
|
(with-test-prefix "expressions"
|
|
|
|
(with-test-prefix "missing or extra expression"
|
|
|
|
;; R5RS says:
|
|
;; *Note:* In many dialects of Lisp, the empty combination, (),
|
|
;; is a legitimate expression. In Scheme, combinations must
|
|
;; have at least one subexpression, so () is not a syntactically
|
|
;; valid expression.
|
|
|
|
;; Fixed on 2001-3-3
|
|
(pass-if-exception "empty parentheses \"()\""
|
|
exception:missing/extra-expr
|
|
())))
|
|
|
|
(with-test-prefix "quote"
|
|
#t)
|
|
|
|
(with-test-prefix "quasiquote"
|
|
|
|
(with-test-prefix "unquote"
|
|
|
|
(pass-if "repeated execution"
|
|
(let ((foo (let ((i 0)) (lambda () (set! i (+ i 1)) `(,i)))))
|
|
(and (equal? (foo) '(1)) (equal? (foo) '(2))))))
|
|
|
|
(with-test-prefix "unquote-splicing"
|
|
|
|
(pass-if-exception "extra arguments"
|
|
exception:missing/extra-expr
|
|
(quasiquote ((unquote-splicing (list 1 2) (list 3 4)))))))
|
|
|
|
(with-test-prefix "begin"
|
|
|
|
(pass-if "legal (begin)"
|
|
(begin)
|
|
#t)
|
|
|
|
(expect-fail-exception "illegal (begin)"
|
|
exception:bad-body
|
|
(if #t (begin))
|
|
#t))
|
|
|
|
(with-test-prefix "lambda"
|
|
|
|
(with-test-prefix "bad formals"
|
|
|
|
(pass-if-exception "(lambda)"
|
|
exception:bad-formals
|
|
(lambda))
|
|
|
|
(pass-if-exception "(lambda . \"foo\")"
|
|
exception:bad-formals
|
|
(lambda . "foo"))
|
|
|
|
(pass-if-exception "(lambda \"foo\")"
|
|
exception:bad-formals
|
|
(lambda "foo"))
|
|
|
|
(pass-if-exception "(lambda \"foo\" #f)"
|
|
exception:bad-formals
|
|
(eval '(lambda "foo" #f)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(lambda (x 1) 2)"
|
|
exception:bad-formals
|
|
(lambda (x 1) 2))
|
|
|
|
(pass-if-exception "(lambda (1 x) 2)"
|
|
exception:bad-formals
|
|
(lambda (1 x) 2))
|
|
|
|
(pass-if-exception "(lambda (x \"a\") 2)"
|
|
exception:bad-formals
|
|
(lambda (x "a") 2))
|
|
|
|
(pass-if-exception "(lambda (\"a\" x) 2)"
|
|
exception:bad-formals
|
|
(lambda ("a" x) 2)))
|
|
|
|
(with-test-prefix "duplicate formals"
|
|
|
|
;; Fixed on 2001-3-3
|
|
(pass-if-exception "(lambda (x x) 1)"
|
|
exception:duplicate-formals
|
|
(lambda (x x) 1))
|
|
|
|
;; Fixed on 2001-3-3
|
|
(pass-if-exception "(lambda (x x x) 1)"
|
|
exception:duplicate-formals
|
|
(lambda (x x x) 1)))
|
|
|
|
(with-test-prefix "bad body"
|
|
|
|
(pass-if-exception "(lambda ())"
|
|
exception:bad-body
|
|
(lambda ()))))
|
|
|
|
(with-test-prefix "let"
|
|
|
|
(with-test-prefix "bindings"
|
|
|
|
(pass-if-exception "late binding"
|
|
exception:unbound-var
|
|
(let ((x 1) (y x)) y)))
|
|
|
|
(with-test-prefix "bad bindings"
|
|
|
|
(pass-if-exception "(let)"
|
|
exception:bad-bindings
|
|
(let))
|
|
|
|
(pass-if-exception "(let 1)"
|
|
exception:bad-bindings
|
|
(let 1))
|
|
|
|
(pass-if-exception "(let (x))"
|
|
exception:bad-bindings
|
|
(let (x)))
|
|
|
|
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
|
;; (Even although the body is bad as well...)
|
|
(pass-if-exception "(let ((x)))"
|
|
exception:bad-body
|
|
(let ((x))))
|
|
|
|
(pass-if-exception "(let (x) 1)"
|
|
exception:bad-bindings
|
|
(let (x) 1))
|
|
|
|
(pass-if-exception "(let ((x)) 3)"
|
|
exception:bad-bindings
|
|
(let ((x)) 3))
|
|
|
|
(pass-if-exception "(let ((x 1) y) x)"
|
|
exception:bad-bindings
|
|
(let ((x 1) y) x))
|
|
|
|
(pass-if-exception "(let ((1 2)) 3)"
|
|
exception:bad-var
|
|
(eval '(let ((1 2)) 3)
|
|
(interaction-environment))))
|
|
|
|
(with-test-prefix "duplicate bindings"
|
|
|
|
(pass-if-exception "(let ((x 1) (x 2)) x)"
|
|
exception:duplicate-bindings
|
|
(let ((x 1) (x 2)) x)))
|
|
|
|
(with-test-prefix "bad body"
|
|
|
|
(pass-if-exception "(let ())"
|
|
exception:bad-body
|
|
(let ()))
|
|
|
|
(pass-if-exception "(let ((x 1)))"
|
|
exception:bad-body
|
|
(let ((x 1))))))
|
|
|
|
(with-test-prefix "named let"
|
|
|
|
(with-test-prefix "initializers"
|
|
|
|
(pass-if "evaluated in outer environment"
|
|
(let ((f -))
|
|
(eqv? (let f ((n (f 1))) n) -1))))
|
|
|
|
(with-test-prefix "bad bindings"
|
|
|
|
(pass-if-exception "(let x (y))"
|
|
exception:bad-bindings
|
|
(let x (y))))
|
|
|
|
(with-test-prefix "bad body"
|
|
|
|
(pass-if-exception "(let x ())"
|
|
exception:bad-body
|
|
(let x ()))
|
|
|
|
(pass-if-exception "(let x ((y 1)))"
|
|
exception:bad-body
|
|
(let x ((y 1))))))
|
|
|
|
(with-test-prefix "let*"
|
|
|
|
(with-test-prefix "bindings"
|
|
|
|
(pass-if "(let* ((x 1) (x 2)) ...)"
|
|
(let* ((x 1) (x 2))
|
|
(= x 2)))
|
|
|
|
(pass-if "(let* ((x 1) (x x)) ...)"
|
|
(let* ((x 1) (x x))
|
|
(= x 1))))
|
|
|
|
(with-test-prefix "bad bindings"
|
|
|
|
(pass-if-exception "(let*)"
|
|
exception:bad-bindings
|
|
(let*))
|
|
|
|
(pass-if-exception "(let* 1)"
|
|
exception:bad-bindings
|
|
(let* 1))
|
|
|
|
(pass-if-exception "(let* (x))"
|
|
exception:bad-bindings
|
|
(let* (x)))
|
|
|
|
(pass-if-exception "(let* (x) 1)"
|
|
exception:bad-bindings
|
|
(let* (x) 1))
|
|
|
|
(pass-if-exception "(let* ((x)) 3)"
|
|
exception:bad-bindings
|
|
(let* ((x)) 3))
|
|
|
|
(pass-if-exception "(let* ((x 1) y) x)"
|
|
exception:bad-bindings
|
|
(let* ((x 1) y) x))
|
|
|
|
(pass-if-exception "(let* x ())"
|
|
exception:bad-bindings
|
|
(eval '(let* x ())
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(let* x (y))"
|
|
exception:bad-bindings
|
|
(eval '(let* x (y))
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(let* ((1 2)) 3)"
|
|
exception:bad-var
|
|
(eval '(let* ((1 2)) 3)
|
|
(interaction-environment))))
|
|
|
|
(with-test-prefix "bad body"
|
|
|
|
(pass-if-exception "(let* ())"
|
|
exception:bad-body
|
|
(let* ()))
|
|
|
|
(pass-if-exception "(let* ((x 1)))"
|
|
exception:bad-body
|
|
(let* ((x 1))))))
|
|
|
|
(with-test-prefix "letrec"
|
|
|
|
(with-test-prefix "bindings"
|
|
|
|
(pass-if-exception "initial bindings are undefined"
|
|
exception:unbound-var
|
|
(let ((x 1))
|
|
(letrec ((x 1) (y x)) y))))
|
|
|
|
(with-test-prefix "bad bindings"
|
|
|
|
(pass-if-exception "(letrec)"
|
|
exception:bad-bindings
|
|
(letrec))
|
|
|
|
(pass-if-exception "(letrec 1)"
|
|
exception:bad-bindings
|
|
(letrec 1))
|
|
|
|
(pass-if-exception "(letrec (x))"
|
|
exception:bad-bindings
|
|
(letrec (x)))
|
|
|
|
(pass-if-exception "(letrec (x) 1)"
|
|
exception:bad-bindings
|
|
(letrec (x) 1))
|
|
|
|
(pass-if-exception "(letrec ((x)) 3)"
|
|
exception:bad-bindings
|
|
(letrec ((x)) 3))
|
|
|
|
(pass-if-exception "(letrec ((x 1) y) x)"
|
|
exception:bad-bindings
|
|
(letrec ((x 1) y) x))
|
|
|
|
(pass-if-exception "(letrec x ())"
|
|
exception:bad-bindings
|
|
(eval '(letrec x ())
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(letrec x (y))"
|
|
exception:bad-bindings
|
|
(eval '(letrec x (y))
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(letrec ((1 2)) 3)"
|
|
exception:bad-var
|
|
(eval '(letrec ((1 2)) 3)
|
|
(interaction-environment))))
|
|
|
|
(with-test-prefix "duplicate bindings"
|
|
|
|
(pass-if-exception "(letrec ((x 1) (x 2)) x)"
|
|
exception:duplicate-bindings
|
|
(letrec ((x 1) (x 2)) x)))
|
|
|
|
(with-test-prefix "bad body"
|
|
|
|
(pass-if-exception "(letrec ())"
|
|
exception:bad-body
|
|
(letrec ()))
|
|
|
|
(pass-if-exception "(letrec ((x 1)))"
|
|
exception:bad-body
|
|
(letrec ((x 1))))))
|
|
|
|
(with-test-prefix "if"
|
|
|
|
(with-test-prefix "missing or extra expressions"
|
|
|
|
(pass-if-exception "(if)"
|
|
exception:missing/extra-expr
|
|
(eval '(if)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(if 1 2 3 4)"
|
|
exception:missing/extra-expr
|
|
(eval '(if 1 2 3 4)
|
|
(interaction-environment)))))
|
|
|
|
(with-test-prefix "cond"
|
|
|
|
(with-test-prefix "bad or missing clauses"
|
|
|
|
(pass-if-exception "(cond)"
|
|
exception:bad/missing-clauses
|
|
(cond))
|
|
|
|
(pass-if-exception "(cond #t)"
|
|
exception:bad/missing-clauses
|
|
(cond #t))
|
|
|
|
(pass-if-exception "(cond 1)"
|
|
exception:bad/missing-clauses
|
|
(cond 1))
|
|
|
|
(pass-if-exception "(cond 1 2)"
|
|
exception:bad/missing-clauses
|
|
(cond 1 2))
|
|
|
|
(pass-if-exception "(cond 1 2 3)"
|
|
exception:bad/missing-clauses
|
|
(cond 1 2 3))
|
|
|
|
(pass-if-exception "(cond 1 2 3 4)"
|
|
exception:bad/missing-clauses
|
|
(cond 1 2 3 4))
|
|
|
|
(pass-if-exception "(cond ())"
|
|
exception:bad/missing-clauses
|
|
(cond ()))
|
|
|
|
(pass-if-exception "(cond () 1)"
|
|
exception:bad/missing-clauses
|
|
(cond () 1))
|
|
|
|
(pass-if-exception "(cond (1) 1)"
|
|
exception:bad/missing-clauses
|
|
(cond (1) 1))))
|
|
|
|
(with-test-prefix "cond =>"
|
|
|
|
(with-test-prefix "else is handled correctly"
|
|
|
|
(pass-if "else =>"
|
|
(let ((=> 'foo))
|
|
(eq? (cond (else =>)) 'foo)))
|
|
|
|
(pass-if "else => identity"
|
|
(let* ((=> 'foo))
|
|
(eq? (cond (else => identity)) identity))))
|
|
|
|
(with-test-prefix "bad formals"
|
|
|
|
(pass-if-exception "=> (lambda (x 1) 2)"
|
|
exception:bad-formals
|
|
(cond (1 => (lambda (x 1) 2))))))
|
|
|
|
(with-test-prefix "case"
|
|
|
|
(with-test-prefix "bad or missing clauses"
|
|
|
|
(pass-if-exception "(case)"
|
|
exception:bad/missing-clauses
|
|
(case))
|
|
|
|
(pass-if-exception "(case . \"foo\")"
|
|
exception:bad/missing-clauses
|
|
(case . "foo"))
|
|
|
|
(pass-if-exception "(case 1)"
|
|
exception:bad/missing-clauses
|
|
(case 1))
|
|
|
|
(pass-if-exception "(case 1 . \"foo\")"
|
|
exception:bad/missing-clauses
|
|
(case 1 . "foo"))
|
|
|
|
(pass-if-exception "(case 1 \"foo\")"
|
|
exception:bad/missing-clauses
|
|
(case 1 "foo"))
|
|
|
|
(pass-if-exception "(case 1 ())"
|
|
exception:bad/missing-clauses
|
|
(case 1 ()))
|
|
|
|
(pass-if-exception "(case 1 (\"foo\"))"
|
|
exception:bad/missing-clauses
|
|
(case 1 ("foo")))
|
|
|
|
(pass-if-exception "(case 1 (\"foo\" \"bar\"))"
|
|
exception:bad/missing-clauses
|
|
(case 1 ("foo" "bar")))
|
|
|
|
;; According to R5RS, the following one is syntactically correct.
|
|
;; (pass-if-exception "(case 1 (() \"bar\"))"
|
|
;; exception:bad/missing-clauses
|
|
;; (case 1 (() "bar")))
|
|
|
|
(pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"
|
|
exception:bad/missing-clauses
|
|
(case 1 ((2) "bar") . "foo"))
|
|
|
|
(pass-if-exception "(case 1 (else #f) ((1) #t))"
|
|
exception:bad/missing-clauses
|
|
(case 1 ((2) "bar") (else)))
|
|
|
|
(pass-if-exception "(case 1 (else #f) . \"foo\")"
|
|
exception:bad/missing-clauses
|
|
(case 1 (else #f) . "foo"))
|
|
|
|
(pass-if-exception "(case 1 (else #f) ((1) #t))"
|
|
exception:bad/missing-clauses
|
|
(case 1 (else #f) ((1) #t)))))
|
|
|
|
(with-test-prefix "define"
|
|
|
|
(with-test-prefix "currying"
|
|
|
|
(pass-if "(define ((foo)) #f)"
|
|
(define ((foo)) #t)
|
|
((foo))))
|
|
|
|
(with-test-prefix "missing or extra expressions"
|
|
|
|
(pass-if-exception "(define)"
|
|
exception:missing/extra-expr
|
|
(define))))
|
|
|
|
(with-test-prefix "set!"
|
|
|
|
(with-test-prefix "missing or extra expressions"
|
|
|
|
(pass-if-exception "(set!)"
|
|
exception:missing/extra-expr
|
|
(eval '(set!)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(set! 1)"
|
|
exception:missing/extra-expr
|
|
(eval '(set! 1)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(set! 1 2 3)"
|
|
exception:missing/extra-expr
|
|
(eval '(set! 1 2 3)
|
|
(interaction-environment))))
|
|
|
|
(with-test-prefix "bad variable"
|
|
|
|
(pass-if-exception "(set! \"\" #t)"
|
|
exception:bad-var
|
|
(eval '(set! "" #t)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(set! 1 #t)"
|
|
exception:bad-var
|
|
(eval '(set! 1 #t)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(set! #t #f)"
|
|
exception:bad-var
|
|
(eval '(set! #t #f)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(set! #f #t)"
|
|
exception:bad-var
|
|
(eval '(set! #f #t)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(set! #\space #f)"
|
|
exception:bad-var
|
|
(eval '(set! #\space #f)
|
|
(interaction-environment)))))
|
|
|
|
(with-test-prefix "quote"
|
|
|
|
(with-test-prefix "missing or extra expression"
|
|
|
|
(pass-if-exception "(quote)"
|
|
exception:missing/extra-expr
|
|
(eval '(quote)
|
|
(interaction-environment)))
|
|
|
|
(pass-if-exception "(quote a b)"
|
|
exception:missing/extra-expr
|
|
(eval '(quote a b)
|
|
(interaction-environment)))))
|