1 ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
3 ;;;; Copyright 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
5 ;;;; This program is free software; you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation; either version 2, or (at your option)
8 ;;;; any later version.
10 ;;;; This program is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with this software; see the file COPYING. If not, write to
17 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18 ;;;; Boston, MA 02110-1301 USA
20 (define-module (test-suite test-posix)
21 :use-module (test-suite lib))
24 ;; FIXME: The following exec tests are disabled since on an i386 debian with
25 ;; glibc 2.3.2 they seem to interact badly with threads.test, the latter
26 ;; dies with signal 32 (one of the SIGRTs). Don't know how or why, or who's
27 ;; at fault (though it seems to happen with or without the recent memory
28 ;; leak fix in these error cases).
34 ;; (with-test-prefix "execl"
35 ;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
36 ;; (execl "./nosuchprog" "./nosuchprog" "some arg")))
42 ;; (with-test-prefix "execlp"
43 ;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
44 ;; (execlp "./nosuchprog" "./nosuchprog" "some arg")))
50 ;; (with-test-prefix "execle"
51 ;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
52 ;; (execle "./nosuchprog" '() "./nosuchprog" "some arg"))
53 ;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
54 ;; (execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg")))
61 (with-test-prefix "mkstemp!"
63 ;; the temporary names used in the tests here are kept to 8 characters so
64 ;; they'll work on a DOS 8.3 file system
66 (define (string-copy str)
67 (list->string (string->list str)))
69 (pass-if-exception "number arg" exception:wrong-type-arg
72 (pass-if "filename string modified"
73 (let* ((template "T-XXXXXX")
74 (str (string-copy template))
76 (result (not (string=? str template))))
84 (with-test-prefix "putenv"
87 (putenv "FOO=something")
88 (equal? "something" (getenv "FOO")))
93 (equal? "two" (getenv "FOO")))
97 (equal? "" (getenv "FOO")))
102 (not (getenv "FOO")))
104 (pass-if "modifying string doesn't change env"
105 (let ((s (string-copy "FOO=bar")))
107 (string-set! s 5 #\x)
108 (equal? "bar" (getenv "FOO")))))
114 (with-test-prefix "setenv"
117 (setenv "FOO" "something")
118 (equal? "something" (getenv "FOO")))
123 (equal? "two" (getenv "FOO")))
127 (equal? "" (getenv "FOO")))
130 (setenv "FOO" "something")
132 (not (getenv "FOO"))))
138 (with-test-prefix "unsetenv"
141 (putenv "FOO=something")
143 (not (getenv "FOO")))
148 (not (getenv "FOO"))))
154 (with-test-prefix "ttyname"
156 (pass-if-exception "non-tty argument" exception:system-error
157 ;; This used to crash in 1.8.1 and earlier.
158 (let ((file (false-if-exception
159 (open-output-file "/dev/null"))))