mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-16 18:50:23 +02:00
Code Activity

Changes from arch/CVS synchronization

Browse source
This commit is contained in:
Ludovic Courtès 2007-06-07 08:44:27 +00:00
parent 8edec42a34
commit 3b58a13b8b
8 changed files with 50 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

7
test-suite/ChangeLog
View file

@ -1,3 +1,10 @@
2007-06-07 Ludovic Courtès <ludovic.courtes@laas.fr>
* lib.scm (exception:system-error): New variable.
* tests/posix.test (ttyname): New test prefix. Catches a bug
reported by Dan McMahill.
2007-05-09 Ludovic Courtès <ludo@chbouib.org>
* tests/srfi-19.test ((current-time time-tai) works): Use `time?'.

3
test-suite/lib.scm
View file

@ -29,6 +29,7 @@
exception:wrong-num-args exception:wrong-type-arg
exception:numerical-overflow
exception:struct-set!-denied
exception:system-error
exception:miscellaneous-error
exception:string-contains-nul
@ -257,6 +258,8 @@
(cons 'numerical-overflow "^Numerical overflow"))
(define exception:struct-set!-denied
(cons 'misc-error "^set! denied for field"))
(define exception:system-error
(cons 'system-error ".*"))
(define exception:miscellaneous-error
(cons 'misc-error "^.*"))

21
test-suite/tests/posix.test
View file

@ -1,6 +1,6 @@
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
;;;;
;;;; Copyright 2003, 2004, 2006 Free Software Foundation, Inc.
;;;; Copyright 2003, 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
@ -17,7 +17,8 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (test-suite lib))
(define-module (test-suite test-posix)
:use-module (test-suite lib))
;; FIXME: The following exec tests are disabled since on an i386 debian with
@ -145,3 +146,19 @@
(putenv "FOO=")
(unsetenv "FOO")
(not (getenv "FOO"))))
;;
;; ttyname
;;
(with-test-prefix "ttyname"
(pass-if-exception "non-tty argument" exception:system-error
;; This used to crash in 1.8.1 and earlier.
(let ((file (false-if-exception
(open-output-file "/dev/null"))))
(if (not file)
(throw 'unsupported)
(ttyname file)))))