mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-29 00:10:21 +02:00
* tests/syntax.test: Added some tests, updated some others with
respect to recent changes in eval.c. Further, extracted test cases for guile's extended set! functionality to srfi-17.test. * tests/srfi-17.test: New file.
This commit is contained in:
Dirk Herrmann
parent
302c12b4b7
commit
7171f1ab47
3 changed files with 147 additions and 89 deletions
|
|
@ -1,3 +1,11 @@
|
|||
2001-11-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* tests/syntax.test: Added some tests, updated some others with
|
||||
respect to recent changes in eval.c. Further, extracted test
|
||||
cases for guile's extended set! functionality to srfi-17.test.
|
||||
|
||||
* tests/srfi-17.test: New file.
|
||||
|
||||
2001-11-04 Stefan Jahn <stefan@lkcc.org>
|
||||
|
||||
* tests/ports.test: Run (close-port) before (delete-file) if
|
||||
|
|
|
|||
32
test-suite/tests/srfi-17.test
Normal file
32
test-suite/tests/srfi-17.test
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
;;;; srfi-17.test --- test suite for Guile's SRFI-17 functions. -*- 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
|
||||
|
||||
(use-modules (srfi srfi-17))
|
||||
|
||||
(with-test-prefix "set!"
|
||||
|
||||
(with-test-prefix "target is not procedure with setter"
|
||||
|
||||
(pass-if-exception "(set! (symbol->string 'x) 1)"
|
||||
exception:wrong-type-arg
|
||||
(set! (symbol->string 'x) 1))
|
||||
|
||||
(pass-if-exception "(set! '#f 1)"
|
||||
exception:wrong-type-arg
|
||||
(set! '#f 1))))
|
||||
|
|
@ -51,6 +51,34 @@
|
|||
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"
|
||||
|
|
@ -63,10 +91,6 @@
|
|||
exception:bad-formals
|
||||
(lambda . "foo"))
|
||||
|
||||
(pass-if-exception "(lambda ())"
|
||||
exception:bad-formals
|
||||
(lambda ()))
|
||||
|
||||
(pass-if-exception "(lambda \"foo\")"
|
||||
exception:bad-formals
|
||||
(lambda "foo"))
|
||||
|
|
@ -101,7 +125,13 @@
|
|||
;; Fixed on 2001-3-3
|
||||
(pass-if-exception "(lambda (x x x) 1)"
|
||||
exception:duplicate-formals
|
||||
(lambda (x x x) 1))))
|
||||
(lambda (x x x) 1)))
|
||||
|
||||
(with-test-prefix "bad body"
|
||||
|
||||
(pass-if-exception "(lambda ())"
|
||||
exception:bad-body
|
||||
(lambda ()))))
|
||||
|
||||
(with-test-prefix "let"
|
||||
|
||||
|
|
@ -111,35 +141,25 @@
|
|||
exception:unbound-var
|
||||
(let ((x 1) (y x)) y)))
|
||||
|
||||
(with-test-prefix "bad body"
|
||||
(with-test-prefix "bad bindings"
|
||||
|
||||
(pass-if-exception "(let ())"
|
||||
exception:bad-body
|
||||
(let ()))
|
||||
|
||||
(pass-if-exception "(let ((x 1)))"
|
||||
exception:bad-body
|
||||
(let ((x 1))))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let)"
|
||||
exception:bad-body
|
||||
exception:bad-bindings
|
||||
(let))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let 1)"
|
||||
exception:bad-body
|
||||
exception:bad-bindings
|
||||
(let 1))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let (x))"
|
||||
exception:bad-body
|
||||
(let (x))))
|
||||
exception:bad-bindings
|
||||
(let (x)))
|
||||
|
||||
(with-test-prefix "bad bindings"
|
||||
;; 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
|
||||
|
|
@ -161,10 +181,32 @@
|
|||
|
||||
(pass-if-exception "(let ((x 1) (x 2)) x)"
|
||||
exception:duplicate-bindings
|
||||
(let ((x 1) (x 2)) x))))
|
||||
(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 ())"
|
||||
|
|
@ -173,13 +215,7 @@
|
|||
|
||||
(pass-if-exception "(let x ((y 1)))"
|
||||
exception:bad-body
|
||||
(let x ((y 1))))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let x (y))"
|
||||
exception:bad-body
|
||||
(let x (y)))))
|
||||
(let x ((y 1))))))
|
||||
|
||||
(with-test-prefix "let*"
|
||||
|
||||
|
|
@ -193,35 +229,19 @@
|
|||
(let* ((x 1) (x x))
|
||||
(= x 1))))
|
||||
|
||||
(with-test-prefix "bad body"
|
||||
(with-test-prefix "bad bindings"
|
||||
|
||||
(pass-if-exception "(let* ())"
|
||||
exception:bad-body
|
||||
(let* ()))
|
||||
|
||||
(pass-if-exception "(let* ((x 1)))"
|
||||
exception:bad-body
|
||||
(let* ((x 1))))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let*)"
|
||||
exception:bad-body
|
||||
exception:bad-bindings
|
||||
(let*))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let* 1)"
|
||||
exception:bad-body
|
||||
exception:bad-bindings
|
||||
(let* 1))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(let* (x))"
|
||||
exception:bad-body
|
||||
(let* (x))))
|
||||
|
||||
(with-test-prefix "bad bindings"
|
||||
exception:bad-bindings
|
||||
(let* (x)))
|
||||
|
||||
(pass-if-exception "(let* (x) 1)"
|
||||
exception:bad-bindings
|
||||
|
|
@ -245,7 +265,17 @@
|
|||
|
||||
(pass-if-exception "(let* ((1 2)) 3)"
|
||||
exception:bad-var
|
||||
(let* ((1 2)) 3))))
|
||||
(let* ((1 2)) 3)))
|
||||
|
||||
(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"
|
||||
|
||||
|
|
@ -256,35 +286,19 @@
|
|||
(let ((x 1))
|
||||
(letrec ((x 1) (y x)) y))))
|
||||
|
||||
(with-test-prefix "bad body"
|
||||
(with-test-prefix "bad bindings"
|
||||
|
||||
(pass-if-exception "(letrec ())"
|
||||
exception:bad-body
|
||||
(letrec ()))
|
||||
|
||||
(pass-if-exception "(letrec ((x 1)))"
|
||||
exception:bad-body
|
||||
(letrec ((x 1))))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(letrec)"
|
||||
exception:bad-body
|
||||
exception:bad-bindings
|
||||
(letrec))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(letrec 1)"
|
||||
exception:bad-body
|
||||
exception:bad-bindings
|
||||
(letrec 1))
|
||||
|
||||
;; FIXME: Wouldn't one rather expect a 'bad bindings' error?
|
||||
;; Hmm, the body is bad as well, isn't it?
|
||||
(pass-if-exception "(letrec (x))"
|
||||
exception:bad-body
|
||||
(letrec (x))))
|
||||
|
||||
(with-test-prefix "bad bindings"
|
||||
exception:bad-bindings
|
||||
(letrec (x)))
|
||||
|
||||
(pass-if-exception "(letrec (x) 1)"
|
||||
exception:bad-bindings
|
||||
|
|
@ -314,7 +328,17 @@
|
|||
|
||||
(pass-if-exception "(letrec ((x 1) (x 2)) x)"
|
||||
exception:duplicate-bindings
|
||||
(letrec ((x 1) (x 2)) x))))
|
||||
(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"
|
||||
|
||||
|
|
@ -445,6 +469,12 @@
|
|||
|
||||
(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)"
|
||||
|
|
@ -489,18 +519,6 @@
|
|||
exception:bad-var
|
||||
(set! #\space #f))))
|
||||
|
||||
(with-test-prefix "generalized set! (SRFI 17)"
|
||||
|
||||
(with-test-prefix "target is not procedure with setter"
|
||||
|
||||
(pass-if-exception "(set! (symbol->string 'x) 1)"
|
||||
exception:wrong-type-arg
|
||||
(set! (symbol->string 'x) 1))
|
||||
|
||||
(pass-if-exception "(set! '#f 1)"
|
||||
exception:wrong-type-arg
|
||||
(set! '#f 1))))
|
||||
|
||||
(with-test-prefix "quote"
|
||||
|
||||
(with-test-prefix "missing or extra expression"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue