~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/posix.test

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
ImportĀ upstreamĀ versionĀ 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
 
2
;;;;
 
3
;;;; Copyright 2003, 2004, 2006 Free Software Foundation, Inc.
 
4
;;;;
 
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.
 
9
;;;;
 
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.
 
14
;;;;
 
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
 
19
 
 
20
(use-modules (test-suite lib))
 
21
 
 
22
 
 
23
;; FIXME: The following exec tests are disabled since on an i386 debian with
 
24
;; glibc 2.3.2 they seem to interact badly with threads.test, the latter
 
25
;; dies with signal 32 (one of the SIGRTs).  Don't know how or why, or who's
 
26
;; at fault (though it seems to happen with or without the recent memory
 
27
;; leak fix in these error cases).
 
28
 
 
29
;;
 
30
;; execl
 
31
;;
 
32
 
 
33
;; (with-test-prefix "execl"
 
34
;;   (pass-if-exception "./nosuchprog" '(system-error . ".*")
 
35
;;     (execl "./nosuchprog" "./nosuchprog" "some arg")))
 
36
  
 
37
;;
 
38
;; execlp
 
39
;;
 
40
 
 
41
;; (with-test-prefix "execlp"
 
42
;;   (pass-if-exception "./nosuchprog" '(system-error . ".*")
 
43
;;     (execlp "./nosuchprog" "./nosuchprog" "some arg")))
 
44
  
 
45
;;
 
46
;; execle
 
47
;;
 
48
 
 
49
;; (with-test-prefix "execle"
 
50
;;   (pass-if-exception "./nosuchprog" '(system-error . ".*")
 
51
;;     (execle "./nosuchprog" '() "./nosuchprog" "some arg"))
 
52
;;   (pass-if-exception "./nosuchprog" '(system-error . ".*")
 
53
;;     (execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg")))
 
54
 
 
55
  
 
56
;;
 
57
;; mkstemp!
 
58
;;
 
59
 
 
60
(with-test-prefix "mkstemp!"
 
61
 
 
62
  ;; the temporary names used in the tests here are kept to 8 characters so
 
63
  ;; they'll work on a DOS 8.3 file system
 
64
 
 
65
  (define (string-copy str)
 
66
    (list->string (string->list str)))
 
67
 
 
68
  (pass-if-exception "number arg" exception:wrong-type-arg
 
69
    (mkstemp! 123))
 
70
 
 
71
  (pass-if "filename string modified"
 
72
    (let* ((template "T-XXXXXX")
 
73
           (str      (string-copy template))
 
74
           (port     (mkstemp! str))
 
75
           (result   (not (string=? str template))))
 
76
      (delete-file str)
 
77
      result)))
 
78
 
 
79
;;
 
80
;; putenv
 
81
;;
 
82
 
 
83
(with-test-prefix "putenv"
 
84
  
 
85
  (pass-if "something"
 
86
    (putenv "FOO=something")
 
87
    (equal? "something" (getenv "FOO")))
 
88
  
 
89
  (pass-if "replacing"
 
90
    (putenv "FOO=one")
 
91
    (putenv "FOO=two")
 
92
    (equal? "two" (getenv "FOO")))
 
93
  
 
94
  (pass-if "empty"
 
95
    (putenv "FOO=")
 
96
    (equal? "" (getenv "FOO")))
 
97
  
 
98
  (pass-if "removing"
 
99
    (putenv "FOO=bar")
 
100
    (putenv "FOO")
 
101
    (not (getenv "FOO")))
 
102
  
 
103
  (pass-if "modifying string doesn't change env"
 
104
    (let ((s (string-copy "FOO=bar")))
 
105
      (putenv s)
 
106
      (string-set! s 5 #\x)
 
107
      (equal? "bar" (getenv "FOO")))))
 
108
 
 
109
;;
 
110
;; setenv
 
111
;;
 
112
 
 
113
(with-test-prefix "setenv"
 
114
  
 
115
  (pass-if "something"
 
116
    (setenv "FOO" "something")
 
117
    (equal? "something" (getenv "FOO")))
 
118
  
 
119
  (pass-if "replacing"
 
120
    (setenv "FOO" "one")
 
121
    (setenv "FOO" "two")
 
122
    (equal? "two" (getenv "FOO")))
 
123
 
 
124
  (pass-if "empty"
 
125
    (setenv "FOO" "")
 
126
    (equal? "" (getenv "FOO")))
 
127
  
 
128
  (pass-if "removing"
 
129
    (setenv "FOO" "something")
 
130
    (setenv "FOO" #f)
 
131
    (not (getenv "FOO"))))
 
132
  
 
133
;;
 
134
;; unsetenv
 
135
;;
 
136
 
 
137
(with-test-prefix "unsetenv"
 
138
  
 
139
  (pass-if "something"
 
140
    (putenv "FOO=something")
 
141
    (unsetenv "FOO")
 
142
    (not (getenv "FOO")))
 
143
  
 
144
  (pass-if "empty"
 
145
    (putenv "FOO=")
 
146
    (unsetenv "FOO")
 
147
    (not (getenv "FOO"))))