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:
parent
f07e4811d3
commit
b233636a08
1 changed files with 37 additions and 91 deletions
|
@ -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")))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue