summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2007-03-07 23:00:22 +0000
committerKevin Ryde <user42@zip.com.au>2007-03-07 23:00:22 +0000
commit004be623c4f68896473b0f9a5285fc76ca1e0b34 (patch)
treea3cc3a6873e8c1df9a65709beefad7c19bb1c778
parent40b2de1c56bd9f81701ef21c4671b89b63150188 (diff)
downloadguile-004be623c4f68896473b0f9a5285fc76ca1e0b34.tar.gz
merge from 1.8 branch
-rw-r--r--test-suite/ChangeLog30
-rw-r--r--test-suite/tests/ports.test13
-rw-r--r--test-suite/tests/sort.test15
-rw-r--r--test-suite/tests/structs.test54
-rw-r--r--test-suite/tests/time.test8
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))