summaryrefslogtreecommitdiff
path: root/test-suite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests')
-rw-r--r--test-suite/tests/alist.test2
-rw-r--r--test-suite/tests/and-let-star.test2
-rw-r--r--test-suite/tests/arbiters.test2
-rw-r--r--test-suite/tests/bit-operations.test2
-rw-r--r--test-suite/tests/c-api.test2
-rw-r--r--test-suite/tests/chars.test2
-rw-r--r--test-suite/tests/common-list.test2
-rw-r--r--test-suite/tests/continuations.test2
-rw-r--r--test-suite/tests/dynamic-scope.test2
-rw-r--r--test-suite/tests/elisp.test2
-rw-r--r--test-suite/tests/environments.test2
-rw-r--r--test-suite/tests/eval.test2
-rw-r--r--test-suite/tests/exceptions.test2
-rw-r--r--test-suite/tests/filesys.test92
-rw-r--r--test-suite/tests/format.test2
-rw-r--r--test-suite/tests/fractions.test2
-rw-r--r--test-suite/tests/gc.test2
-rw-r--r--test-suite/tests/getopt-long.test2
-rw-r--r--test-suite/tests/goops.test2
-rw-r--r--test-suite/tests/guardians.test2
-rw-r--r--test-suite/tests/hash.test2
-rw-r--r--test-suite/tests/hooks.test2
-rw-r--r--test-suite/tests/import.test2
-rw-r--r--test-suite/tests/interp.test2
-rw-r--r--test-suite/tests/list.test2
-rw-r--r--test-suite/tests/load.test2
-rw-r--r--test-suite/tests/modules.test50
-rw-r--r--test-suite/tests/multilingual.nottest2
-rw-r--r--test-suite/tests/numbers.test2
-rw-r--r--test-suite/tests/optargs.test2
-rw-r--r--test-suite/tests/options.test2
-rw-r--r--test-suite/tests/pairs.test2
-rw-r--r--test-suite/tests/poe.test60
-rw-r--r--test-suite/tests/popen.test2
-rw-r--r--test-suite/tests/ports.test38
-rw-r--r--test-suite/tests/posix.test2
-rw-r--r--test-suite/tests/q.test2
-rw-r--r--test-suite/tests/r4rs.test2
-rw-r--r--test-suite/tests/r5rs_pitfall.test2
-rw-r--r--test-suite/tests/ramap.test2
-rw-r--r--test-suite/tests/receive.test2
-rw-r--r--test-suite/tests/regexp.test2
-rw-r--r--test-suite/tests/slib.test292
-rw-r--r--test-suite/tests/socket.test2
-rw-r--r--test-suite/tests/sort.test2
-rw-r--r--test-suite/tests/srcprop.test2
-rw-r--r--test-suite/tests/srfi-10.test2
-rw-r--r--test-suite/tests/srfi-11.test2
-rw-r--r--test-suite/tests/srfi-13.test39
-rw-r--r--test-suite/tests/srfi-14.test2
-rw-r--r--test-suite/tests/srfi-17.test2
-rw-r--r--test-suite/tests/srfi-19.test2
-rw-r--r--test-suite/tests/srfi-31.test2
-rw-r--r--test-suite/tests/srfi-34.test2
-rw-r--r--test-suite/tests/srfi-39.test2
-rw-r--r--test-suite/tests/srfi-4.test2
-rw-r--r--test-suite/tests/srfi-6.test2
-rw-r--r--test-suite/tests/srfi-60.test2
-rw-r--r--test-suite/tests/srfi-9.test2
-rw-r--r--test-suite/tests/streams.test2
-rw-r--r--test-suite/tests/strings.test99
-rw-r--r--test-suite/tests/symbols.test2
-rw-r--r--test-suite/tests/syncase.test2
-rw-r--r--test-suite/tests/syntax.test2
-rw-r--r--test-suite/tests/threads.test2
-rw-r--r--test-suite/tests/time.test2
-rw-r--r--test-suite/tests/unif.test77
-rw-r--r--test-suite/tests/vectors.test2
-rw-r--r--test-suite/tests/version.test2
-rw-r--r--test-suite/tests/weaks.test2
70 files changed, 506 insertions, 365 deletions
diff --git a/test-suite/tests/alist.test b/test-suite/tests/alist.test
index e3722dc4d..a9e9b0d24 100644
--- a/test-suite/tests/alist.test
+++ b/test-suite/tests/alist.test
@@ -1,5 +1,5 @@
;;;; alist.test --- tests guile's alists -*- scheme -*-
-;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/and-let-star.test b/test-suite/tests/and-let-star.test
index 099c3422d..0f74934f7 100644
--- a/test-suite/tests/and-let-star.test
+++ b/test-suite/tests/and-let-star.test
@@ -1,6 +1,6 @@
;;;; and-let-star.test --- Tests for Guile and-let-star module. -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006 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
diff --git a/test-suite/tests/arbiters.test b/test-suite/tests/arbiters.test
index 3aedabd24..7591f02f0 100644
--- a/test-suite/tests/arbiters.test
+++ b/test-suite/tests/arbiters.test
@@ -1,6 +1,6 @@
;;;; arbiters.test --- test arbiters functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/bit-operations.test b/test-suite/tests/bit-operations.test
index f63f894ea..8e35257b3 100644
--- a/test-suite/tests/bit-operations.test
+++ b/test-suite/tests/bit-operations.test
@@ -1,5 +1,5 @@
;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2003, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/c-api.test b/test-suite/tests/c-api.test
index 6c24c0aac..4a165d4cb 100644
--- a/test-suite/tests/c-api.test
+++ b/test-suite/tests/c-api.test
@@ -1,7 +1,7 @@
;;;; c-api.test --- complementary test suite for the c-api -*- scheme -*-
;;;; MDJ 990915 <djurfeldt@nada.kth.se>
;;;;
-;;;; Copyright (C) 1999 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2006 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
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index b7319466b..f14c832dd 100644
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -1,7 +1,7 @@
;;;; chars.test --- test suite for Guile's char functions -*- scheme -*-
;;;; Greg J. Badros <gjb@cs.washington.edu>
;;;;
-;;;; Copyright (C) 2000 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2006 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
diff --git a/test-suite/tests/common-list.test b/test-suite/tests/common-list.test
index 511da1f57..c6f659b1e 100644
--- a/test-suite/tests/common-list.test
+++ b/test-suite/tests/common-list.test
@@ -1,5 +1,5 @@
;;;; common-list.test --- tests guile's common list functions -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test
index 6d8a6a69a..c1b6803cb 100644
--- a/test-suite/tests/continuations.test
+++ b/test-suite/tests/continuations.test
@@ -1,7 +1,7 @@
;;;; -*- scheme -*-
;;;; continuations.test --- test suite for continutations
;;;;
-;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006 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
diff --git a/test-suite/tests/dynamic-scope.test b/test-suite/tests/dynamic-scope.test
index 60f91f05e..d7a06a411 100644
--- a/test-suite/tests/dynamic-scope.test
+++ b/test-suite/tests/dynamic-scope.test
@@ -1,7 +1,7 @@
;;;; -*- scheme -*-
;;;; dynamic-scop.test --- test suite for dynamic scoping constructs
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test
index 964e8baeb..067f7b16f 100644
--- a/test-suite/tests/elisp.test
+++ b/test-suite/tests/elisp.test
@@ -1,5 +1,5 @@
;;;; elisp.test --- tests guile's elisp support -*- scheme -*-
-;;;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/environments.test b/test-suite/tests/environments.test
index d96295f22..19117e3b5 100644
--- a/test-suite/tests/environments.test
+++ b/test-suite/tests/environments.test
@@ -1,5 +1,5 @@
;;;; environments.test -*- scheme -*-
-;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 18541da94..6bca6235c 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -1,5 +1,5 @@
;;;; eval.test --- tests guile's evaluator -*- scheme -*-
-;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/exceptions.test b/test-suite/tests/exceptions.test
index 565cc8fea..4a9c1cb55 100644
--- a/test-suite/tests/exceptions.test
+++ b/test-suite/tests/exceptions.test
@@ -1,5 +1,5 @@
;;;; exceptions.test --- tests for Guile's exception handling -*- scheme -*-
-;;;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6ccb021ea..7ba4feb06 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -1,6 +1,6 @@
;;;; filesys.test --- test file system functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -17,7 +17,14 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-filesys)
- #:use-module (test-suite lib))
+ #:use-module (test-suite lib)
+ #:use-module (test-suite guile-test))
+
+(define (test-file)
+ (data-file-name "filesys-test.tmp"))
+(define (test-symlink)
+ (data-file-name "filesys-test-link.tmp"))
+
;;;
;;; copy-file
@@ -37,3 +44,84 @@
(let ((old-next (next-fd)))
(false-if-exception (copy-file "/dev/null" "no/such/dir/foo"))
(= old-next (next-fd)))))
+
+;;;
+;;; lstat
+;;;
+
+(with-test-prefix "lstat"
+
+ (pass-if "normal file"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (eqv? 5 (stat:size (lstat (test-file)))))
+
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (delete-file (test-symlink))
+ (if (not (false-if-exception
+ (begin (symlink (test-file) (test-symlink)) #t)))
+ (display "cannot create symlink, lstat test skipped\n")
+ (pass-if "symlink"
+ ;; not much to test, except that it works
+ (->bool (lstat (test-symlink))))))
+
+;;;
+;;; opendir and friends
+;;;
+
+(with-test-prefix "opendir"
+
+ (with-test-prefix "root directory"
+ (let ((d (opendir "/")))
+ (pass-if "not empty"
+ (string? (readdir d)))
+ (pass-if "all entries are strings"
+ (let more ()
+ (let ((f (readdir d)))
+ (cond ((string? f)
+ (more))
+ ((eof-object? f)
+ #t)
+ (else
+ #f)))))
+ (closedir d))))
+
+;;;
+;;; stat
+;;;
+
+(with-test-prefix "stat"
+
+ (with-test-prefix "filename"
+
+ (pass-if "size"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (eqv? 5 (stat:size (stat (test-file))))))
+
+ (with-test-prefix "file descriptor"
+
+ (pass-if "size"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let* ((fd (open-fdes (test-file) O_RDONLY))
+ (st (stat fd)))
+ (close-fdes fd)
+ (eqv? 5 (stat:size st)))))
+
+ (with-test-prefix "port"
+
+ (pass-if "size"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let* ((port (open-file (test-file) "r+"))
+ (st (stat port)))
+ (close-port port)
+ (eqv? 5 (stat:size st))))))
+
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index a99dfa737..3cdc8dc75 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -1,7 +1,7 @@
;;;; format.test --- test suite for Guile's CL-ish format -*- scheme -*-
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;;
-;;;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2006 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
diff --git a/test-suite/tests/fractions.test b/test-suite/tests/fractions.test
index 9a95e126b..0e1a4d6c1 100644
--- a/test-suite/tests/fractions.test
+++ b/test-suite/tests/fractions.test
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006 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 version 2 as
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index c425e2daa..abd714b9a 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -1,5 +1,5 @@
;;;; gc.test --- test guile's garbage collection -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test
index b73eeb402..fe4a8872b 100644
--- a/test-suite/tests/getopt-long.test
+++ b/test-suite/tests/getopt-long.test
@@ -1,7 +1,7 @@
;;;; getopt-long.test --- long options processing -*- scheme -*-
;;;; Thien-Thi Nguyen <ttn@gnu.org> --- August 2001
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 7939ab296..dd61369c5 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -1,6 +1,6 @@
;;;; goops.test --- test suite for GOOPS -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001,2003,2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006 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
diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test
index f07e4a904..15f67e609 100644
--- a/test-suite/tests/guardians.test
+++ b/test-suite/tests/guardians.test
@@ -1,7 +1,7 @@
;;;; guardians.test --- test suite for Guile Guardians -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- July 1999
;;;;
-;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006 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
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 2c589a088..8215df118 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -1,6 +1,6 @@
;;;; hash.test --- test guile hashing -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/hooks.test b/test-suite/tests/hooks.test
index cb43c019d..f8ed39919 100644
--- a/test-suite/tests/hooks.test
+++ b/test-suite/tests/hooks.test
@@ -1,5 +1,5 @@
;;;; hooks.test --- tests guile's hooks implementation -*- scheme -*-
-;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/import.test b/test-suite/tests/import.test
index cdd75e5a2..4c4be02b2 100644
--- a/test-suite/tests/import.test
+++ b/test-suite/tests/import.test
@@ -1,5 +1,5 @@
;;;; import.test --- test selective and renaming imports -*- scheme -*-
-;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/interp.test b/test-suite/tests/interp.test
index c84e6b397..a091515b9 100644
--- a/test-suite/tests/interp.test
+++ b/test-suite/tests/interp.test
@@ -1,6 +1,6 @@
;;;; interp.test --- tests for bugs in the Guile interpreter -*- scheme -*-
;;;;
-;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006 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
diff --git a/test-suite/tests/list.test b/test-suite/tests/list.test
index 98c14e9e6..7dc0ef0f8 100644
--- a/test-suite/tests/list.test
+++ b/test-suite/tests/list.test
@@ -1,5 +1,5 @@
;;;; list.test --- tests guile's lists -*- scheme -*-
-;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/load.test b/test-suite/tests/load.test
index 6bcd01f2e..a71a34716 100644
--- a/test-suite/tests/load.test
+++ b/test-suite/tests/load.test
@@ -1,7 +1,7 @@
;;;; load.test --- test LOAD and path searching functions -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
;;;;
-;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006 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
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
new file mode 100644
index 000000000..9541f0662
--- /dev/null
+++ b/test-suite/tests/modules.test
@@ -0,0 +1,50 @@
+;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
+
+;;;; Copyright (C) 2006 Free Software Foundation, Inc.
+;;;;
+;;;; 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 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(use-modules (test-suite lib))
+
+(with-test-prefix "autoload"
+
+ (pass-if "autoloaded"
+ (catch #t
+ (lambda ()
+ ;; Simple autoloading.
+ (eval '(begin
+ (define-module (test-autoload-one)
+ :autoload (ice-9 q) (make-q))
+ (not (not make-q)))
+ (current-module)))
+ (lambda (key . args)
+ #f)))
+
+ ;; In Guile 1.8.0 this failed because the binder in
+ ;; `make-autoload-interface' would try to remove the autoload interface
+ ;; from the module's "uses" without making sure it is still part of these
+ ;; "uses".
+ ;;
+ (pass-if "autoloaded+used"
+ (catch #t
+ (lambda ()
+ (eval '(begin
+ (define-module (test-autoload-two)
+ :autoload (ice-9 q) (make-q)
+ :use-module (ice-9 q))
+ (not (not make-q)))
+ (current-module)))
+ (lambda (key . args)
+ #f))))
diff --git a/test-suite/tests/multilingual.nottest b/test-suite/tests/multilingual.nottest
index 18163d3a1..46a3ee2d3 100644
--- a/test-suite/tests/multilingual.nottest
+++ b/test-suite/tests/multilingual.nottest
@@ -2,7 +2,7 @@
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
;;;; This isn't a test yet, because we don't have multilingual support yet.
;;;;
-;;;; Copyright (C) 1999 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2006 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
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index c19b065ca..54117b044 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -1,5 +1,5 @@
;;;; numbers.test --- tests guile's numbers -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index a45d3609b..040b68ba4 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -1,7 +1,7 @@
;;;; optargs.test --- test suite for optional arg processing -*- scheme -*-
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/options.test b/test-suite/tests/options.test
index 168676b30..f2f87143b 100644
--- a/test-suite/tests/options.test
+++ b/test-suite/tests/options.test
@@ -1,6 +1,6 @@
;;;; options.test --- test suite for options interface -*- scheme -*-
;;;;
-;;;; Copyright (C) 2002 Free Software Foundation, Inc.
+;;;; Copyright (C) 2002, 2006 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
diff --git a/test-suite/tests/pairs.test b/test-suite/tests/pairs.test
index 97fd34f64..af2f3e275 100644
--- a/test-suite/tests/pairs.test
+++ b/test-suite/tests/pairs.test
@@ -1,6 +1,6 @@
;;;; pairs.test --- test suite for Guile's pair functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006 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
diff --git a/test-suite/tests/poe.test b/test-suite/tests/poe.test
index 8d353de55..6c7625602 100644
--- a/test-suite/tests/poe.test
+++ b/test-suite/tests/poe.test
@@ -1,6 +1,6 @@
;;;; poe.test --- exercise ice-9/poe.scm -*- scheme -*-
;;;;
-;;;; Copyright 2003 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -25,6 +25,64 @@
;; pure-funcq
;;
+(with-test-prefix "pure-funcq"
+
+ (with-test-prefix "no args"
+ (define obj (vector 123)) ;; not gc'ed
+ (define called #f)
+ (define (foo)
+ (set! called #t)
+ obj)
+
+ (let ((func (pure-funcq foo)))
+
+ (pass-if "called first"
+ (set! called #f)
+ (and (eq? obj (func))
+ called))
+
+ (pass-if "not called second"
+ (set! called #f)
+ (and (eq? obj (func))
+ (not called)))))
+
+ (with-test-prefix "1 arg"
+ (define obj1 (vector 123)) ;; not gc'ed
+ (define obj2 (vector 456)) ;; not gc'ed
+ (define called #f)
+ (define (foo sym)
+ (set! called #t)
+ (case sym
+ ((x) obj1)
+ ((y) obj2)
+ (else (error "oops"))))
+
+ (let ((func (pure-funcq foo)))
+
+ (pass-if "called first x"
+ (set! called #f)
+ (and (eq? obj1 (func 'x))
+ called))
+
+ (pass-if "not called second x"
+ (set! called #f)
+ (and (eq? obj1 (func 'x))
+ (not called)))
+
+ (pass-if "called first y"
+ (set! called #f)
+ (and (eq? obj2 (func 'y))
+ called))
+
+ (pass-if "not called second y"
+ (set! called #f)
+ (and (eq? obj2 (func 'y))
+ (not called)))
+
+ (pass-if "not called third x"
+ (set! called #f)
+ (and (eq? obj1 (func 'x))
+ (not called))))))
;;
;; perfect-funcq
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index d83d91c4c..19d3edc49 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -1,6 +1,6 @@
;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*-
;;;;
-;;;; Copyright 2003 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index aab58d071..15f888e00 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -1,7 +1,7 @@
;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2006 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
@@ -538,6 +538,42 @@
(while (not (eof-object? (read-char port))))
(= 8 (port-column port))))))
+;;;
+;;; truncate-file
+;;;
+
+(with-test-prefix "truncate-file"
+
+ (with-test-prefix "filename"
+
+ (pass-if "shorten"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (truncate-file (test-file) 1)
+ (eqv? 1 (stat:size (stat (test-file))))))
+
+ (with-test-prefix "file descriptor"
+
+ (pass-if "shorten"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let ((fd (open-fdes (test-file) O_RDWR)))
+ (truncate-file fd 1)
+ (close-fdes fd))
+ (eqv? 1 (stat:size (stat (test-file))))))
+
+ (with-test-prefix "file port"
+
+ (pass-if "shorten"
+ (call-with-output-file (test-file)
+ (lambda (port)
+ (display "hello" port)))
+ (let ((port (open-file (test-file) "r+")))
+ (truncate-file port 1))
+ (eqv? 1 (stat:size (stat (test-file)))))))
+
;;;; testing read-delimited and friends
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 6e8d51af5..cd76a44ec 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -1,6 +1,6 @@
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2004 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2004, 2006 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
diff --git a/test-suite/tests/q.test b/test-suite/tests/q.test
index d9238c3ee..5c24e5202 100644
--- a/test-suite/tests/q.test
+++ b/test-suite/tests/q.test
@@ -1,6 +1,6 @@
;;;; q.test --- test (ice-9 q) module -*- scheme -*-
;;;;
-;;;; Copyright 2004 Free Software Foundation, Inc.
+;;;; Copyright 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/r4rs.test b/test-suite/tests/r4rs.test
index 8abfabb3e..e47364c66 100644
--- a/test-suite/tests/r4rs.test
+++ b/test-suite/tests/r4rs.test
@@ -1,5 +1,5 @@
;;;; r4rs.test --- tests for R4RS compliance -*- scheme -*-
-;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/r5rs_pitfall.test b/test-suite/tests/r5rs_pitfall.test
index 1c99b5fc9..8fa78e9c1 100644
--- a/test-suite/tests/r5rs_pitfall.test
+++ b/test-suite/tests/r5rs_pitfall.test
@@ -1,5 +1,5 @@
;;;; r5rs_pitfall.test --- tests some pitfalls in R5RS -*- scheme -*-
-;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index 088a2d3e8..d923bc1f2 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -1,6 +1,6 @@
;;;; ramap.test --- test array mapping functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/receive.test b/test-suite/tests/receive.test
index 2619a268a..4b55bdf9f 100644
--- a/test-suite/tests/receive.test
+++ b/test-suite/tests/receive.test
@@ -1,6 +1,6 @@
;;;; receive.test --- Test suite for Guile receive module. -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006 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
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index 1e7cdd20d..7e7914534 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -1,7 +1,7 @@
;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
;;;;
-;;;; Copyright (C) 1999, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2004, 2006 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
diff --git a/test-suite/tests/slib.test b/test-suite/tests/slib.test
index fa9a601ce..e69de29bb 100644
--- a/test-suite/tests/slib.test
+++ b/test-suite/tests/slib.test
@@ -1,292 +0,0 @@
-;;;; slib.test --- Test suite for Guile's SLIB glue. -*- scheme -*-
-;;;;
-;;;; Copyright 2003, 2004 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., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
-
-;; These tests are run only if slib is available. slib will need to be
-;; installed (or linked) under the configured guile $prefix.
-;;
-(if (catch #t
- (lambda () (resolve-module '(ice-9 slib)))
- (lambda args #f))
- (begin
-
- (define-module (test-suite test-ice-9-slib)
- #:use-module (test-suite lib)
- #:use-module (ice-9 slib))
-
-
- (with-test-prefix "Configuration"
-
- ;;
- ;; char-code-limit
- ;;
-
- (with-test-prefix "char-code-limit"
- (pass-if "integer" (integer? char-code-limit)))
-
- ;;
- ;; most-positive-fixnum
- ;;
-
- (with-test-prefix "most-positive-fixnum"
- (pass-if "integer" (integer? most-positive-fixnum)))
-
- ;;
- ;; slib:form-feed
- ;;
-
- (with-test-prefix "slib:form-feed"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "char" (char? slib:form-feed)))
-
- ;;
- ;; slib:report
- ;;
-
- (with-test-prefix "slib:report"
- (pass-if "exists" (procedure? slib:report)))
-
- ;;
- ;; slib:report-version
- ;;
-
- (with-test-prefix "slib:report-version"
- (pass-if "exists" (procedure? slib:report-version)))
-
- ;;
- ;; slib:tab
- ;;
-
- (with-test-prefix "slib:tab"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "char" (char? slib:tab)))
-
- ;;
- ;; software-type
- ;;
-
- (with-test-prefix "software-type"
- (pass-if "exists" (procedure? software-type))))
-
-
- (with-test-prefix "Input/Output"
-
- ;;
- ;; call-with-open-ports
- ;;
-
- (with-test-prefix "call-with-open-ports"
- (pass-if "exists" (procedure? call-with-open-ports))
-
- (pass-if "close on return"
- (let ((port (open-input-file "/dev/null")))
- (call-with-open-ports port (lambda (port) #f))
- (port-closed? port))))
-
- ;;
- ;; delete-file
- ;;
-
- ;; in guile 1.6.4 and earlier delete-file didn't match the slib spec
- (with-test-prefix "delete-file"
- (pass-if "non existant file"
- (eq? #f (delete-file "nosuchfile")))
- (pass-if "existing file"
- (call-with-output-file "slibtest.tmp" noop)
- (eq? #t (delete-file "slibtest.tmp"))))
-
- ;;
- ;; output-port-height
- ;;
-
- (with-test-prefix "output-port-height"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? output-port-height)))
-
- ;;
- ;; output-port-width
- ;;
-
- (with-test-prefix "output-port-width"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? output-port-width)))
-
- ;;
- ;; open-file
- ;;
-
- ;; this style open-file is only a requirement in slib 3a1 and up, but
- ;; we provide it always
- (with-test-prefix "open-file"
- (pass-if "r" (port? (open-file "/dev/null" 'r)))
- (pass-if "rb" (port? (open-file "/dev/null" 'rb)))
- (pass-if "w" (port? (open-file "/dev/null" 'w)))
- (pass-if "wb" (port? (open-file "/dev/null" 'wb)))))
-
-
- (with-test-prefix "System stuff"
-
- ;;
- ;; browse-url
- ;;
-
- (with-test-prefix "browse-url"
- (pass-if "exists" (procedure? browse-url)))
-
- ;;
- ;; slib:error
- ;;
-
- (with-test-prefix "slib:error"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? slib:error)))
-
- ;;
- ;; slib:eval
- ;;
-
- (with-test-prefix "slib:eval"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? slib:eval)))
-
- ;;
- ;; slib:eval-load
- ;;
-
- (with-test-prefix "slib:eval-load"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? slib:eval-load)))
-
- ;;
- ;; slib:exit
- ;;
-
- (with-test-prefix "slib:exit"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? slib:exit)))
-
- ;;
- ;; slib:load
- ;;
-
- (with-test-prefix "slib:load"
- (pass-if "exists" (procedure? slib:load)))
-
- ;;
- ;; slib:load-source
- ;;
-
- (with-test-prefix "slib:load-source"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? slib:load-source)))
-
- ;;
- ;; slib:warn
- ;;
-
- (with-test-prefix "slib:warn"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? slib:warn))))
-
-
- (with-test-prefix "Miscellany"
-
- ;;
- ;; identity
- ;;
-
- (with-test-prefix "identity"
- (pass-if "exists" (procedure? identity)))
-
- (with-test-prefix "Legacy"
-
- ;;
- ;; nil
- ;;
-
- ;; in guile 1.6.4 and earlier this was missing
- (with-test-prefix "nil"
- (pass-if "value" (eq? #f nil)))
-
- ;;
- ;; t
- ;;
-
- ;; in guile 1.6.4 and earlier this was missing
- (with-test-prefix "t"
- (pass-if "value" (eq? #t t)))))
-
-
- ;;
- ;; rev2-procedures
- ;;
-
- ;; in guile 1.6.4 the 'rev2-procedures feature we defined claimed
- ;; these existed, but they didn't
- (with-test-prefix "rev2-procedures"
- (require 'rev2-procedures)
- (pass-if "-1+" (procedure? -1+))
- (pass-if "<?" (procedure? <?))
- (pass-if "<=?" (procedure? <=?))
- (pass-if "=?" (procedure? =?))
- (pass-if ">?" (procedure? >?))
- (pass-if ">=?" (procedure? >=?)))
-
-
- ;;
- ;; system
- ;;
-
- ;; in guile 1.6.4 and earlier system didn't match the slib spec
- (with-test-prefix "system"
- (pass-if "exit 0" (= 0 (system "exit 0")))
- (pass-if "exit 1" (= 1 (system "exit 1")))
- (pass-if "exit 99" (= 99 (system "exit 99"))))
-
-
- (with-test-prefix "Time"
-
- ;;
- ;; difftime
- ;;
-
- (with-test-prefix "difftime"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? difftime)))
-
- ;;
- ;; offset-time
- ;;
-
- (with-test-prefix "offset-time"
- ;; in guile 1.6.4 this wasn't exported
- (pass-if "exists" (procedure? offset-time))))
-
-
- (require 'array)
- (with-test-prefix "array"
-
- ;;
- ;; create-array
- ;;
-
- ;; create-array isn't in old slib, but when it exists it should work
- (if (defined? 'create-array)
- (with-test-prefix "create-array"
- (pass-if "As32 create"
- (array? (create-array (As32 0) '(0 1)))))))))
diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test
index 79df42f0b..dd91f35b6 100644
--- a/test-suite/tests/socket.test
+++ b/test-suite/tests/socket.test
@@ -1,6 +1,6 @@
;;;; socket.test --- test socket functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/sort.test b/test-suite/tests/sort.test
index 77c2da858..af4578ca0 100644
--- a/test-suite/tests/sort.test
+++ b/test-suite/tests/sort.test
@@ -1,5 +1,5 @@
;;;; sort.test --- tests Guile's sort functions -*- scheme -*-
-;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006 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
diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test
index 084a752be..5bfe68080 100644
--- a/test-suite/tests/srcprop.test
+++ b/test-suite/tests/srcprop.test
@@ -1,6 +1,6 @@
;;;; srcprop.test --- test Guile source properties -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/srfi-10.test b/test-suite/tests/srfi-10.test
index 96642e00a..248c04ff7 100644
--- a/test-suite/tests/srfi-10.test
+++ b/test-suite/tests/srfi-10.test
@@ -1,7 +1,7 @@
;;;; srfi-10.test --- Test suite for Guile's SRFI-10 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-10
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/srfi-11.test b/test-suite/tests/srfi-11.test
index 3c2ad2f37..ec2ed86c8 100644
--- a/test-suite/tests/srfi-11.test
+++ b/test-suite/tests/srfi-11.test
@@ -1,6 +1,6 @@
;;;; srfi-11.test --- exercise SRFI-11 let-values
;;;;
-;;;; Copyright 2004 Free Software Foundation, Inc.
+;;;; Copyright 2004, 2006 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
diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test
index b135434e5..89759d0d3 100644
--- a/test-suite/tests/srfi-13.test
+++ b/test-suite/tests/srfi-13.test
@@ -1,7 +1,7 @@
;;;; srfi-13.test --- Test suite for Guile's SRFI-13 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-07
;;;;
-;;;; Copyright (C) 2001, 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2004, 2005, 2006 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
@@ -18,11 +18,20 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
-(use-modules (srfi srfi-13) (srfi srfi-14) (test-suite lib))
+(define-module (test-strings)
+ #:use-module (test-suite lib)
+ #:use-module (srfi srfi-13)
+ #:use-module (srfi srfi-14))
+
(define exception:strict-infix-grammar
(cons 'misc-error "^strict-infix"))
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+ (apply string (map integer->char args)))
+
+
;;;
;;; string-any
;;;
@@ -185,6 +194,32 @@
(pass-if (equal? "abc" (string-concatenate '("a" "b" "c")))))
+;;
+;; string-compare
+;;
+
+(with-test-prefix "string-compare"
+
+ (pass-if "same as char<?"
+ (eq? (char<? (integer->char 0) (integer->char 255))
+ (string-compare (string-ints 0) (string-ints 255)
+ (lambda (pos) #t) ;; lt
+ (lambda (pos) #f) ;; eq
+ (lambda (pos) #f))))) ;; gt
+
+;;
+;; string-compare-ci
+;;
+
+(with-test-prefix "string-compare-ci"
+
+ (pass-if "same as char-ci<?"
+ (eq? (char-ci<? (integer->char 0) (integer->char 255))
+ (string-compare-ci (string-ints 0) (string-ints 255)
+ (lambda (pos) #t) ;; lt
+ (lambda (pos) #f) ;; eq
+ (lambda (pos) #f))))) ;; gt
+
;;;
;;; string-concatenate/shared
;;;
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
index ca4e961e6..fabb7842d 100644
--- a/test-suite/tests/srfi-14.test
+++ b/test-suite/tests/srfi-14.test
@@ -1,7 +1,7 @@
;;;; srfi-14.test --- Test suite for Guile's SRFI-14 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-07-16
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/srfi-17.test b/test-suite/tests/srfi-17.test
index 52a195576..806b420a6 100644
--- a/test-suite/tests/srfi-17.test
+++ b/test-suite/tests/srfi-17.test
@@ -1,6 +1,6 @@
;;;; srfi-17.test --- test suite for Guile's SRFI-17 functions. -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2005, 2006 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
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index f694b8613..126198afa 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -1,7 +1,7 @@
;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;;
-;;;; Copyright (C) 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006 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
diff --git a/test-suite/tests/srfi-31.test b/test-suite/tests/srfi-31.test
index 5f00a73b5..bd6977333 100644
--- a/test-suite/tests/srfi-31.test
+++ b/test-suite/tests/srfi-31.test
@@ -1,6 +1,6 @@
;;;; srfi-31.test --- Test suite for Guile's SRFI-31 functions. -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/test-suite/tests/srfi-34.test b/test-suite/tests/srfi-34.test
index 1875f39da..2c7f4b202 100644
--- a/test-suite/tests/srfi-34.test
+++ b/test-suite/tests/srfi-34.test
@@ -1,6 +1,6 @@
;;;; srfi-34.test --- test suite for SRFI-34 -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2004, 2006 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
diff --git a/test-suite/tests/srfi-39.test b/test-suite/tests/srfi-39.test
index 2c09d138d..1b7923a25 100644
--- a/test-suite/tests/srfi-39.test
+++ b/test-suite/tests/srfi-39.test
@@ -1,6 +1,6 @@
;;;; srfi-39.test --- -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006 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
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index b2e80f5e4..ee773a3f9 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -1,7 +1,7 @@
;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-06-26
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/srfi-6.test b/test-suite/tests/srfi-6.test
index 1b485939b..217fc9f78 100644
--- a/test-suite/tests/srfi-6.test
+++ b/test-suite/tests/srfi-6.test
@@ -1,6 +1,6 @@
;;;; srfi-6.test --- test suite for SRFI-6 -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006 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
diff --git a/test-suite/tests/srfi-60.test b/test-suite/tests/srfi-60.test
index a521529a8..5822cb1d0 100644
--- a/test-suite/tests/srfi-60.test
+++ b/test-suite/tests/srfi-60.test
@@ -1,6 +1,6 @@
;;;; srfi-60.test --- Test suite for Guile's SRFI-60 functions. -*- scheme -*-
;;;;
-;;;; Copyright 2005 Free Software Foundation, Inc.
+;;;; Copyright 2005, 2006 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
diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test
index 4781b80ad..9a6f8e31a 100644
--- a/test-suite/tests/srfi-9.test
+++ b/test-suite/tests/srfi-9.test
@@ -1,7 +1,7 @@
;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-10
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/streams.test b/test-suite/tests/streams.test
index 1d5fc8d95..92277c19c 100644
--- a/test-suite/tests/streams.test
+++ b/test-suite/tests/streams.test
@@ -1,6 +1,6 @@
;;;; streams.test --- test Guile ice-9 streams module -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006 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
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index 7a2d40d40..aa9196e68 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -1,7 +1,7 @@
;;;; strings.test --- test suite for Guile's string functions -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- August 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006 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
@@ -18,11 +18,22 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
-(use-modules (test-suite lib))
+(define-module (test-strings)
+ #:use-module (test-suite lib))
+
(define exception:read-only-string
(cons 'misc-error "^string is read-only"))
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+ (apply string (map integer->char args)))
+
+
+;;
+;; string=?
+;;
+
(with-test-prefix "string=?"
(pass-if "respects 1st parameter's string length"
@@ -41,6 +52,10 @@
exception:wrong-type-arg
(string=? "a" 'b))))
+;;
+;; string<?
+;;
+
(with-test-prefix "string<?"
(pass-if "respects string length"
@@ -55,7 +70,15 @@
(pass-if-exception "2nd argument symbol"
exception:wrong-type-arg
- (string<? "a" 'b))))
+ (string<? "a" 'b)))
+
+ (pass-if "same as char<?"
+ (eq? (char<? (integer->char 0) (integer->char 255))
+ (string<? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci<?
+;;
(with-test-prefix "string-ci<?"
@@ -71,7 +94,75 @@
(pass-if-exception "2nd argument symbol"
exception:wrong-type-arg
- (string-ci<? "a" 'b))))
+ (string-ci<? "a" 'b)))
+
+ (pass-if "same as char-ci<?"
+ (eq? (char-ci<? (integer->char 0) (integer->char 255))
+ (string-ci<? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string<=?
+;;
+
+(with-test-prefix "string<=?"
+
+ (pass-if "same as char<=?"
+ (eq? (char<=? (integer->char 0) (integer->char 255))
+ (string<=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci<=?
+;;
+
+(with-test-prefix "string-ci<=?"
+
+ (pass-if "same as char-ci<=?"
+ (eq? (char-ci<=? (integer->char 0) (integer->char 255))
+ (string-ci<=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string>?
+;;
+
+(with-test-prefix "string>?"
+
+ (pass-if "same as char>?"
+ (eq? (char>? (integer->char 0) (integer->char 255))
+ (string>? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci>?
+;;
+
+(with-test-prefix "string-ci>?"
+
+ (pass-if "same as char-ci>?"
+ (eq? (char-ci>? (integer->char 0) (integer->char 255))
+ (string-ci>? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string>=?
+;;
+
+(with-test-prefix "string>=?"
+
+ (pass-if "same as char>=?"
+ (eq? (char>=? (integer->char 0) (integer->char 255))
+ (string>=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci>=?
+;;
+
+(with-test-prefix "string-ci>=?"
+
+ (pass-if "same as char-ci>=?"
+ (eq? (char-ci>=? (integer->char 0) (integer->char 255))
+ (string-ci>=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-set!
+;;
(with-test-prefix "string-set!"
diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test
index 88632aa1e..b57667f7f 100644
--- a/test-suite/tests/symbols.test
+++ b/test-suite/tests/symbols.test
@@ -1,6 +1,6 @@
;;;; symbols.test --- test suite for Guile's symbols -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index 4df9dfa2b..1184f7b54 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -1,6 +1,6 @@
;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006 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
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index e944d30a4..37d608ce7 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,6 +1,6 @@
;;;; syntax.test --- test suite for Guile's syntactic forms -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001,2003,2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2005, 2006 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
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index 88109655f..511927719 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
-;;;; Copyright 2003 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006 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
diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test
index b872e1b99..3cbbb15f8 100644
--- a/test-suite/tests/time.test
+++ b/test-suite/tests/time.test
@@ -1,7 +1,7 @@
;;;; time.test --- test suite for Guile's time functions -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- June 1999, 2004
;;;;
-;;;; Copyright (C) 1999, 2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2004, 2006 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
diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test
index 062a34e91..a5be1826f 100644
--- a/test-suite/tests/unif.test
+++ b/test-suite/tests/unif.test
@@ -1,6 +1,6 @@
;;;; unif.test --- tests guile's uniform arrays -*- scheme -*-
;;;;
-;;;; Copyright 2004 Free Software Foundation, Inc.
+;;;; Copyright 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -325,6 +325,20 @@
(with-test-prefix "array-set!"
+ (with-test-prefix "bitvector"
+
+ ;; in Guile 1.8.0 a bug in bitvector_set() caused a segv in array-set!
+ ;; on a bitvector like the following
+ (let ((a (make-bitvector 1)))
+ (pass-if "one elem set #t"
+ (begin
+ (array-set! a #t 0)
+ (eq? #t (array-ref a 0))))
+ (pass-if "one elem set #f"
+ (begin
+ (array-set! a #f 0)
+ (eq? #f (array-ref a 0))))))
+
(with-test-prefix "byte"
(let ((a (make-s8vector 1)))
@@ -406,8 +420,69 @@
;;; make-shared-array
;;;
+(define exception:mapping-out-of-range
+ (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
+
(with-test-prefix "make-shared-array"
+ ;; this failed in guile 1.8.0
+ (pass-if "vector unchanged"
+ (let* ((a (make-array #f '(0 7)))
+ (s (make-shared-array a list '(0 7))))
+ (array-equal? a s)))
+
+ (pass-if-exception "vector, high too big" exception:mapping-out-of-range
+ (let* ((a (make-array #f '(0 7))))
+ (make-shared-array a list '(0 8))))
+
+ (pass-if-exception "vector, low too big" exception:out-of-range
+ (let* ((a (make-array #f '(0 7))))
+ (make-shared-array a list '(-1 7))))
+
+ (pass-if "truncate columns"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
+ #2((a b) (d e) (g h))))
+
+ (pass-if "pick one column"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+ (lambda (i) (list i 2))
+ '(0 2))
+ #(c f i)))
+
+ (pass-if "diagonal"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+ (lambda (i) (list i i))
+ '(0 2))
+ #(a e i)))
+
+ ;; this failed in guile 1.8.0
+ (pass-if "2 dims from 1 dim"
+ (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
+ (lambda (i j) (list (+ (* i 3) j)))
+ 4 3)
+ #2((a b c) (d e f) (g h i) (j k l))))
+
+ (pass-if "reverse columns"
+ (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+ (lambda (i j) (list i (- 2 j)))
+ 3 3)
+ #2((c b a) (f e d) (i h g))))
+
+ (pass-if "fixed offset, 0 based becomes 1 based"
+ (let* ((x #2((a b c) (d e f) (g h i)))
+ (y (make-shared-array x
+ (lambda (i j) (list (1- i) (1- j)))
+ '(1 3) '(1 3))))
+ (and (eq? (array-ref x 0 0) 'a)
+ (eq? (array-ref y 1 1) 'a))))
+
+ ;; this failed in guile 1.8.0
+ (pass-if "stride every third element"
+ (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
+ (lambda (i) (list (* i 3)))
+ 4)
+ #1(a d g j)))
+
(pass-if "shared of shared"
(let* ((a #2((1 2 3) (4 5 6) (7 8 9)))
(s1 (make-shared-array a (lambda (i) (list i 1)) 3))
diff --git a/test-suite/tests/vectors.test b/test-suite/tests/vectors.test
index c4907f872..1fb16bcb0 100644
--- a/test-suite/tests/vectors.test
+++ b/test-suite/tests/vectors.test
@@ -1,6 +1,6 @@
;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006 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
diff --git a/test-suite/tests/version.test b/test-suite/tests/version.test
index 0ef230629..b2a491950 100644
--- a/test-suite/tests/version.test
+++ b/test-suite/tests/version.test
@@ -1,7 +1,7 @@
;;;; versions.test --- test suite for Guile's version functions -*- scheme -*-
;;;; Greg J. Badros <gjb@cs.washington.edu>
;;;;
-;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006 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
diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test
index 64edb735e..7bb77b07c 100644
--- a/test-suite/tests/weaks.test
+++ b/test-suite/tests/weaks.test
@@ -1,5 +1,5 @@
;;;; weaks.test --- tests guile's weaks -*- scheme -*-
-;;;; Copyright (C) 1999, 2001, 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2003, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public