summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2001-11-17 11:44:06 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2001-11-17 11:44:06 +0000
commit7171f1ab47ee8c9950cbb4cb90ede4c68fffa31e (patch)
treed56764928b87ea09e4a70bdc007f47ce3a5f5039
parent302c12b4b780e15934873ef267b636d1a3c1707e (diff)
downloadguile-7171f1ab47ee8c9950cbb4cb90ede4c68fffa31e.tar.gz
* 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.
-rw-r--r--test-suite/ChangeLog8
-rw-r--r--test-suite/tests/srfi-17.test32
-rw-r--r--test-suite/tests/syntax.test196
3 files changed, 147 insertions, 89 deletions
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index b91212dad..9f6893202 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -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
diff --git a/test-suite/tests/srfi-17.test b/test-suite/tests/srfi-17.test
new file mode 100644
index 000000000..dc6fd7e06
--- /dev/null
+++ b/test-suite/tests/srfi-17.test
@@ -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))))
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 2c5f06bf2..14836fbc9 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -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"
-
- (pass-if-exception "(let ())"
- exception:bad-body
- (let ()))
-
- (pass-if-exception "(let ((x 1)))"
- exception:bad-body
- (let ((x 1))))
+ (with-test-prefix "bad bindings"
- ;; 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"
-
- (pass-if-exception "(let* ())"
- exception:bad-body
- (let* ()))
-
- (pass-if-exception "(let* ((x 1)))"
- exception:bad-body
- (let* ((x 1))))
+ (with-test-prefix "bad bindings"
- ;; 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"
-
- (pass-if-exception "(letrec ())"
- exception:bad-body
- (letrec ()))
-
- (pass-if-exception "(letrec ((x 1)))"
- exception:bad-body
- (letrec ((x 1))))
+ (with-test-prefix "bad bindings"
- ;; 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"