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

New file, exercise execl, execlp, execle errors.

This commit is contained in:
Kevin Ryde 2004-02-28 23:16:54 +00:00
parent f07e4811d3
commit b233636a08

View file

@ -1,6 +1,5 @@
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
;;;;
;;;; Copyright 2003, 2004 Free Software Foundation, Inc.
;;;; numbers.test --- tests guile's numbers -*- scheme -*-
;;;; Copyright (C) 2004 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
@ -16,109 +15,56 @@
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
;;;; As a special exception, the Free Software Foundation gives permission
;;;; for additional uses of the text contained in its release of GUILE.
;;;;
;;;; The exception is that, if you link the GUILE library with other files
;;;; to produce an executable, this does not by itself cause the
;;;; resulting executable to be covered by the GNU General Public License.
;;;; Your use of that executable is in no way restricted on account of
;;;; linking the GUILE library code into it.
;;;;
;;;; This exception does not however invalidate any other reasons why
;;;; the executable file might be covered by the GNU General Public License.
;;;;
;;;; This exception applies only to the code released by the
;;;; Free Software Foundation under the name GUILE. If you copy
;;;; code from other Free Software Foundation releases into a copy of
;;;; GUILE, as the General Public License permits, the exception does
;;;; not apply to the code that you add in this way. To avoid misleading
;;;; anyone as to the status of such modified files, you must delete
;;;; this exception notice from them.
;;;;
;;;; If you write modifications of your own for GUILE, it is your choice
;;;; whether to permit this exception to apply to your modifications.
;;;; If you do not wish that, delete this exception notice.
(use-modules (test-suite lib))
;; FIXME: The following exec tests are disabled since on an i386 debian with
;; glibc 2.3.2 they seem to interact badly with threads.test, the latter
;; dies with signal 32 (one of the SIGRTs). Don't know how or why, or who's
;; at fault (though it seems to happen with or without the recent memory
;; leak fix in these error cases).
;;
;; execl
;;
;; (with-test-prefix "execl"
;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
;; (execl "./nosuchprog" "./nosuchprog" "some arg")))
(with-test-prefix "execl"
(pass-if-exception "./nosuchprog" '(system-error . ".*")
(execl "./nosuchprog" "./nosuchprog" "some arg")))
;;
;; execlp
;;
;; (with-test-prefix "execlp"
;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
;; (execlp "./nosuchprog" "./nosuchprog" "some arg")))
(with-test-prefix "execlp"
(pass-if-exception "./nosuchprog" '(system-error . ".*")
(execlp "./nosuchprog" "./nosuchprog" "some arg")))
;;
;; execle
;;
;; (with-test-prefix "execle"
;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
;; (execle "./nosuchprog" '() "./nosuchprog" "some arg"))
;; (pass-if-exception "./nosuchprog" '(system-error . ".*")
;; (execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg")))
;;
;; putenv
;;
(with-test-prefix "putenv"
(pass-if "something"
(putenv "FOO=something")
(equal? "something" (getenv "FOO")))
(pass-if "replacing"
(putenv "FOO=one")
(putenv "FOO=two")
(equal? "two" (getenv "FOO")))
(pass-if "empty"
(putenv "FOO=")
(equal? "" (getenv "FOO")))
(pass-if "removing"
(putenv "FOO=bar")
(putenv "FOO")
(not (getenv "FOO")))
(pass-if "modifying string doesn't change env"
(let ((s (string-copy "FOO=bar")))
(putenv s)
(string-set! s 5 #\x)
(equal? "bar" (getenv "FOO")))))
;;
;; setenv
;;
(with-test-prefix "setenv"
(pass-if "something"
(setenv "FOO" "something")
(equal? "something" (getenv "FOO")))
(pass-if "replacing"
(setenv "FOO" "one")
(setenv "FOO" "two")
(equal? "two" (getenv "FOO")))
(pass-if "empty"
(setenv "FOO" "")
(equal? "" (getenv "FOO")))
(pass-if "removing"
(setenv "FOO" "something")
(setenv "FOO" #f)
(not (getenv "FOO"))))
;;
;; unsetenv
;;
(with-test-prefix "unsetenv"
(pass-if "something"
(putenv "FOO=something")
(unsetenv "FOO")
(not (getenv "FOO")))
(pass-if "empty"
(putenv "FOO=")
(unsetenv "FOO")
(not (getenv "FOO"))))
(with-test-prefix "execle"
(pass-if-exception "./nosuchprog" '(system-error . ".*")
(execle "./nosuchprog" '() "./nosuchprog" "some arg"))
(pass-if-exception "./nosuchprog" '(system-error . ".*")
(execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg")))