test-suite/tests/posix.test

   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"))))