diff options
author | Kevin Ryde <user42@zip.com.au> | 2007-03-07 23:00:22 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2007-03-07 23:00:22 +0000 |
commit | 004be623c4f68896473b0f9a5285fc76ca1e0b34 (patch) | |
tree | a3cc3a6873e8c1df9a65709beefad7c19bb1c778 | |
parent | 40b2de1c56bd9f81701ef21c4671b89b63150188 (diff) | |
download | guile-004be623c4f68896473b0f9a5285fc76ca1e0b34.tar.gz |
merge from 1.8 branch
-rw-r--r-- | test-suite/ChangeLog | 30 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 13 | ||||
-rw-r--r-- | test-suite/tests/sort.test | 15 | ||||
-rw-r--r-- | test-suite/tests/structs.test | 54 | ||||
-rw-r--r-- | test-suite/tests/time.test | 8 |
5 files changed, 114 insertions, 6 deletions
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index a4d4e5605..f45cbd891 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,19 @@ +2007-03-08 Kevin Ryde <user42@zip.com.au> + + * tests/structs.test (make-struct): Exercise the error check on tail + array size != 0 when layout spec doesn't have tail array. + (make-vtable): Exercise this. + +2007-02-22 Kevin Ryde <user42@zip.com.au> + + * tests/structs.test (make-struct): New test of type check on a "u" + field, which had been causing an abort(). + +2007-02-20 Neil Jerram <neil@ossau.uklinux.net> + + * standalone/Makefile.am (check_SCRIPTS): Add test-use-srfi, so + that it gets into the distribution. + 2007-02-19 Neil Jerram <neil@ossau.uklinux.net> * standalone/Makefile.am (check_SCRIPTS): Add test-use-srfi, so @@ -18,6 +34,20 @@ (SRFI date/time library)[string->date understands days and months]: New test. +2007-01-27 Kevin Ryde <user42@zip.com.au> + + * tests/ports.test (port-line): Check not truncated to "int" on 64-bit + systems. + +2007-01-25 Kevin Ryde <user42@zip.com.au> + + * tests/sort.test (stable-sort): New test, exercising empty list + input. As reported by Ales Hvezda. + + * tests/time.test (gmtime in another thread): Catch #t all errors from + gmtime in the thread, since it can be a system error not a scheme + out-of-range on 64-bit systems. Reported by Marijn Schouten. + 2007-01-19 Ludovic Courtès <ludovic.courtes@laas.fr> * tests/eval.test (values): New test prefix. Values are structs, diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 9690122b5..2d25f420a 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, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007 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,17 @@ (while (not (eof-object? (read-char port)))) (= 8 (port-column port)))))) +(with-test-prefix "port-line" + + ;; in guile 1.8.1 and earlier port-line was truncated to an int, whereas + ;; scm_t_port actually holds a long; this restricted the range on 64-bit + ;; systems + (pass-if "set most-positive-fixnum/2" + (let ((n (quotient most-positive-fixnum 2)) + (port (open-output-string))) + (set-port-line! port n) + (eqv? n (port-line port))))) + ;;; ;;; seek ;;; diff --git a/test-suite/tests/sort.test b/test-suite/tests/sort.test index af4578ca0..a49c04857 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, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006, 2007 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 @@ -63,3 +63,16 @@ (v (make-shared-array a (lambda (i) (list (- 999 i) 0)) 1000))) (randomize-vector! v 1000) (sorted? (stable-sort! v <) <)))) + + +;;; +;;; stable-sort +;;; + +(with-test-prefix "stable-sort" + + ;; in guile 1.8.0 and 1.8.1 this test failed, an empty list provoked a + ;; wrong-type-arg exception (where it shouldn't) + (pass-if "empty list" + (eq? '() (stable-sort '() <)))) + diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test index 5df4665a3..127115eb2 100644 --- a/test-suite/tests/structs.test +++ b/test-suite/tests/structs.test @@ -102,6 +102,60 @@ (equal? (make-ball red "Bob") (make-ball red "Bill")))))) +;; +;; make-struct +;; + +(define exception:bad-tail + (cons 'misc-error "tail array not allowed unless")) + +(with-test-prefix "make-struct" + + ;; in guile 1.8.1 and earlier, this caused an error throw out of an + ;; SCM_CRITICAL_SECTION_START / SCM_CRITICAL_SECTION_END, which abort()ed + ;; the program + ;; + (pass-if-exception "wrong type for `u' field" exception:wrong-type-arg + (let* ((vv (make-vtable-vtable "" 0)) + (v (make-struct vv 0 (make-struct-layout "uw")))) + (make-struct v 0 'x))) + + ;; In guile 1.8.1 and earlier, and 1.6.8 and earlier, there was no check + ;; on a tail array being created without an R/W/O type for it. This left + ;; it uninitialized by scm_struct_init(), resulting in garbage getting + ;; into an SCM when struct-ref read it (and attempting to print a garbage + ;; SCM can cause a segv). + ;; + (pass-if-exception "no R/W/O for tail array" exception:bad-tail + (let* ((vv (make-vtable-vtable "" 0)) + (v (make-struct vv 0 (make-struct-layout "pw")))) + (make-struct v 123 'x)))) + +;; +;; make-vtable +;; + +(with-test-prefix "make-vtable" + + (pass-if "without printer" + (let* ((vtable (make-vtable "pwpr")) + (struct (make-struct vtable 0 'x 'y))) + (and (eq? 'x (struct-ref struct 0)) + (eq? 'y (struct-ref struct 1))))) + + (pass-if "with printer" + (let () + (define (print struct port) + (display "hello" port)) + + (let* ((vtable (make-vtable "pwpr" print)) + (struct (make-struct vtable 0 'x 'y)) + (str (call-with-output-string + (lambda (port) + (display struct port))))) + (equal? str "hello"))))) + + ;;; Local Variables: ;;; coding: latin-1 ;;; End: diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test index e228dfb09..ebc4499fd 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, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2004, 2006, 2007 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 @@ -34,9 +34,9 @@ (alarm 5) (false-if-exception (gmtime t)) - (join-thread (begin-thread (catch 'out-of-range - (lambda () (gmtime t)) - (lambda args #f)))) + (join-thread (begin-thread (catch #t + (lambda () (gmtime t)) + (lambda args #f)))) (alarm 0) #t)) |