;;;; list.test --- tests guile's lists -*- scheme -*-
-;;;; Copyright (C) 2000 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 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 library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library 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.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser 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
-;;;;
-;;;; As a special exception, the Free Software Foundation gives permission
-;;;; for additional uses of the text contained in its release of GUILE.
-;;;;
-;;;; The exception is that, if you link the GUILE library with other files
-;;;; to produce an executable, this does not by itself cause the
-;;;; resulting executable to be covered by the GNU General Public License.
-;;;; Your use of that executable is in no way restricted on account of
-;;;; linking the GUILE library code into it.
-;;;;
-;;;; This exception does not however invalidate any other reasons why
-;;;; the executable file might be covered by the GNU General Public License.
-;;;;
-;;;; This exception applies only to the code released by the
-;;;; Free Software Foundation under the name GUILE. If you copy
-;;;; code from other Free Software Foundation releases into a copy of
-;;;; GUILE, as the General Public License permits, the exception does
-;;;; not apply to the code that you add in this way. To avoid misleading
-;;;; anyone as to the status of such modified files, you must delete
-;;;; this exception notice from them.
-;;;;
-;;;; If you write modifications of your own for GUILE, it is your choice
-;;;; whether to permit this exception to apply to your modifications.
-;;;; If you do not wish that, delete this exception notice.
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(use-modules (ice-9 documentation))
;;; miscellaneous
;;;
+(define (documented? object)
+ (not (not (object-documentation object))))
+
;;
;; This unique tag is reserved for the unroll and diff-unrolled functions.
;;
(with-test-prefix "append!"
- ;; Is documentation available?
-
- (pass-if "documented?" (object-documentation append!))
+ (pass-if "documented?"
+ (documented? append!))
;; Is the handling of empty lists as arguments correct?
(with-test-prefix "wrong argument"
- (expect-fail "improper list and empty list"
- (catch 'wrong-type-arg
- (lambda ()
- (append! (cons 1 2) '())
- #f)
- (lambda (key . args)
- #t)))
-
- (expect-fail "improper list and list"
- (catch 'wrong-type-arg
- (lambda ()
- (append! (cons 1 2) (list 3 4))
- #f)
- (lambda (key . args)
- #t)))
-
- (expect-fail "list, improper list and list"
- (catch 'wrong-type-arg
- (lambda ()
- (append! (list 1 2) (cons 3 4) (list 5 6))
- #f)
- (lambda (key . args)
- #t)))
+ (expect-fail-exception "improper list and empty list"
+ exception:wrong-type-arg
+ (append! (cons 1 2) '()))
+
+ (expect-fail-exception "improper list and list"
+ exception:wrong-type-arg
+ (append! (cons 1 2) (list 3 4)))
+
+ (expect-fail-exception "list, improper list and list"
+ exception:wrong-type-arg
+ (append! (list 1 2) (cons 3 4) (list 5 6)))
(expect-fail "circular list and empty list"
(let ((foo (list 1 2 3)))
(with-test-prefix "list-ref"
- ;; Is documentation available?
-
- (pass-if "documented?" (object-documentation list-ref))
+ (pass-if "documented?"
+ (documented? list-ref))
(with-test-prefix "argument error"
(with-test-prefix "empty list"
- (pass-if "index 0"
- (catch 'out-of-range
- (lambda ()
- (list-ref '() 0)
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "index > 0"
- (catch 'out-of-range
- (lambda ()
- (list-ref '() 1)
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "index < 0"
- (catch 'out-of-range
- (lambda ()
- (list-ref '() -1)
- #f)
- (lambda (key . args)
- #t))))
+ (pass-if-exception "index 0"
+ exception:out-of-range
+ (list-ref '() 0))
+
+ (pass-if-exception "index > 0"
+ exception:out-of-range
+ (list-ref '() 1))
+
+ (pass-if-exception "index < 0"
+ exception:out-of-range
+ (list-ref '() -1)))
(with-test-prefix "non-empty list"
- (pass-if "index > length"
- (catch 'out-of-range
- (lambda ()
- (list-ref '(1) 1)
- #f)
- (lambda (key . args)
- #t)))
+ (pass-if-exception "index > length"
+ exception:out-of-range
+ (list-ref '(1) 1))
- (pass-if "index < 0"
- (catch 'out-of-range
- (lambda ()
- (list-ref '(1) -1)
- #f)
- (lambda (key . args)
- #t)))))))
+ (pass-if-exception "index < 0"
+ exception:out-of-range
+ (list-ref '(1) -1))))))
;;; list-set!
(with-test-prefix "list-set!"
- ;; Is documentation available?
-
- (pass-if "documented?" (object-documentation list-set!))
+ (pass-if "documented?"
+ (documented? list-set!))
(with-test-prefix "argument error"
(with-test-prefix "empty list"
- (pass-if "index 0"
- (catch 'out-of-range
- (lambda ()
- (list-set! (list) 0 #t)
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "index > 0"
- (catch 'out-of-range
- (lambda ()
- (list-set! (list) 1 #t)
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "index < 0"
- (catch 'out-of-range
- (lambda ()
- (list-set! (list) -1 #t)
- #f)
- (lambda (key . args)
- #t))))
+ (pass-if-exception "index 0"
+ exception:out-of-range
+ (list-set! (list) 0 #t))
+
+ (pass-if-exception "index > 0"
+ exception:out-of-range
+ (list-set! (list) 1 #t))
+
+ (pass-if-exception "index < 0"
+ exception:out-of-range
+ (list-set! (list) -1 #t)))
(with-test-prefix "non-empty list"
- (pass-if "index > length"
- (catch 'out-of-range
- (lambda ()
- (list-set! (list 1) 1 #t)
- #f)
- (lambda (key . args)
- #t)))
+ (pass-if-exception "index > length"
+ exception:out-of-range
+ (list-set! (list 1) 1 #t))
- (pass-if "index < 0"
- (catch 'out-of-range
- (lambda ()
- (list-set! (list 1) -1 #t)
- #f)
- (lambda (key . args)
- #t)))))))
+ (pass-if-exception "index < 0"
+ exception:out-of-range
+ (list-set! (list 1) -1 #t))))))
;;; list-cdr-ref
(with-test-prefix "list-cdr-set!"
- ;; Is documentation available?
-
- (pass-if "documented?" (object-documentation list-cdr-set!))
+ (pass-if "documented?"
+ (documented? list-cdr-set!))
(with-test-prefix "argument error"
(with-test-prefix "empty list"
- (pass-if "index 0"
- (catch 'out-of-range
- (lambda ()
- (list-cdr-set! (list) 0 #t)
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "index > 0"
- (catch 'out-of-range
- (lambda ()
- (list-cdr-set! (list) 1 #t)
- #f)
- (lambda (key . args)
- #t)))
-
- (pass-if "index < 0"
- (catch 'out-of-range
- (lambda ()
- (list-cdr-set! (list) -1 #t)
- #f)
- (lambda (key . args)
- #t))))
+ (pass-if-exception "index 0"
+ exception:out-of-range
+ (list-cdr-set! (list) 0 #t))
+
+ (pass-if-exception "index > 0"
+ exception:out-of-range
+ (list-cdr-set! (list) 1 #t))
+
+ (pass-if-exception "index < 0"
+ exception:out-of-range
+ (list-cdr-set! (list) -1 #t)))
(with-test-prefix "non-empty list"
- (pass-if "index > length"
- (catch 'out-of-range
- (lambda ()
- (list-cdr-set! (list 1) 1 #t)
- #f)
- (lambda (key . args)
- #t)))
+ (pass-if-exception "index > length"
+ exception:out-of-range
+ (list-cdr-set! (list 1) 1 #t))
- (pass-if "index < 0"
- (catch 'out-of-range
- (lambda ()
- (list-cdr-set! (list 1) -1 #t)
- #f)
- (lambda (key . args)
- #t)))))))
+ (pass-if-exception "index < 0"
+ exception:out-of-range
+ (list-cdr-set! (list 1) -1 #t))))))
;;; list-head
;;; list-copy
-;;; sloppy-memq
-
-
-;;; sloppy-memv
-
-
-;;; sloppy-member
-
-
;;; memq
HCoop / bpt / guile.git / blobdiff