Skip to content
Snippets Groups Projects
Commit ba357de8 authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'rtoy-fix-45-run-program-paths' into 'master'

Fix #45 :Handle relative paths in `run-program`

Closes #45

See merge request cmucl/cmucl!25
parents 39dff2ee d2efe772
No related branches found
No related tags found
No related merge requests found
# Ignore default build directories
darwin-[234]
darwin-8bit-[234]
linux-[234]
linux-8bit-[234]
sparc-[234]
sparc-8bit-[234]
build-*
# Ignore emacs files
*~
# Ignore default build directories
# Ignore emacs files
# Ignore fasls # Ignore fasls
# Ignore files generated by TeX
*.fasl *.fasl
*.sse2f
*.x86f
*.ppcf *.ppcf
*.sparcf *.sparcf
*.sse2f
# Ignore files generated by TeX *.x86f
*~
/test-tmp
build-*
darwin-8bit-[234]
darwin-[234]
linux-8bit-[234]
linux-[234]
sparc-8bit-[234]
sparc-[234]
src/docs/cmu-user/*.aux src/docs/cmu-user/*.aux
src/docs/cmu-user/*.cdx src/docs/cmu-user/*.cdx
src/docs/cmu-user/*.cnd src/docs/cmu-user/*.cnd
src/docs/cmu-user/*.fdx src/docs/cmu-user/*.fdx
src/docs/cmu-user/*.fnd src/docs/cmu-user/*.fnd
src/docs/cmu-user/*.idx src/docs/cmu-user/*.idx
src/docs/cmu-user/*.ilg
src/docs/cmu-user/*.log
src/docs/cmu-user/*.out
src/docs/cmu-user/*.pdf
src/docs/cmu-user/*.tdx src/docs/cmu-user/*.tdx
src/docs/cmu-user/*.tnd src/docs/cmu-user/*.tnd
src/docs/cmu-user/*.toc src/docs/cmu-user/*.toc
src/docs/cmu-user/*.vdx src/docs/cmu-user/*.vdx
src/docs/cmu-user/*.vnd src/docs/cmu-user/*.vnd
src/docs/cmu-user/*.ilg
src/docs/cmu-user/*.out
src/docs/cmu-user/*.pdf
src/docs/cmu-user/*.log
...@@ -34,6 +34,12 @@ done ...@@ -34,6 +34,12 @@ done
# Shift out the options # Shift out the options
shift $[$OPTIND - 1] shift $[$OPTIND - 1]
# Create the test directory needed issue.45 test.
rm -rf test-tmp
mkdir test-tmp
ln -s /bin/ls test-tmp/ls-link
if [ $# -eq 0 ]; then if [ $# -eq 0 ]; then
# No args so run all the tests # No args so run all the tests
$LISP -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)' $LISP -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)'
......
...@@ -528,10 +528,7 @@ ...@@ -528,10 +528,7 @@
;; info. Also, establish proc at this level so we can return it. ;; info. Also, establish proc at this level so we can return it.
(let (*close-on-error* *close-in-parent* *handlers-installed* proc) (let (*close-on-error* *close-in-parent* *handlers-installed* proc)
(unwind-protect (unwind-protect
(let ((pfile (unix-namestring (merge-pathnames program "path:") t t)) (let ((cookie (list 0)))
(cookie (list 0)))
(unless pfile
(error (intl:gettext "No such program: ~S") program))
(multiple-value-bind (multiple-value-bind
(stdin input-stream) (stdin input-stream)
(get-descriptor-for input cookie :direction :input (get-descriptor-for input cookie :direction :input
...@@ -570,7 +567,7 @@ ...@@ -570,7 +567,7 @@
env)) env))
(let ((child-pid (let ((child-pid
(without-gcing (without-gcing
(spawn pfile argv envp pty-name (spawn program argv envp pty-name
stdin stdout stderr)))) stdin stdout stderr))))
(when (< child-pid 0) (when (< child-pid 0)
(error (intl:gettext "Could not fork child process: ~A") (error (intl:gettext "Could not fork child process: ~A")
......
...@@ -13250,10 +13250,6 @@ msgstr "" ...@@ -13250,10 +13250,6 @@ msgstr ""
msgid "All args to program must be simple strings -- ~S." msgid "All args to program must be simple strings -- ~S."
msgstr "" msgstr ""
   
#: src/code/run-program.lisp
msgid "No such program: ~S"
msgstr ""
#: src/code/run-program.lisp #: src/code/run-program.lisp
msgid "Could not fork child process: ~A" msgid "Could not fork child process: ~A"
msgstr "" msgstr ""
......
...@@ -65,10 +65,10 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name, ...@@ -65,10 +65,10 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name,
/* Exec the program. */ /* Exec the program. */
execve(program, argv, envp); execve(program, argv, envp);
/* It didn't work, so try /bin/sh. */ /* It didn't work, so try /usr/bin/env. */
argv[0] = program; argv[0] = program;
argv[-1] = "sh"; argv[-1] = "/usr/bin/env";
execve("/bin/sh", argv - 1, envp); execve("/usr/bin/env", argv - 1, envp);
/* The exec didn't work, flame out. */ /* The exec didn't work, flame out. */
exit(1); exit(1);
......
...@@ -405,3 +405,33 @@ ...@@ -405,3 +405,33 @@
(define-test issue.41.2 (define-test issue.41.2
(:tag :issues) (:tag :issues)
(issue-41-tester unix:sigtstp)) (issue-41-tester unix:sigtstp))
(define-test issue.45
(:tag :issues)
;; This depends on run-tests to setup the test directory correctly!
(let* ((test-dir #p"test-tmp/")
(test-dir-name (namestring test-dir)))
(flet ((do-test (program)
(with-output-to-string (s)
(let ((process
(ext:run-program program
(list test-dir-name)
:wait t :output s)))
;; Verify process exited without error and that we
;; got the expected output.
(assert-eql 0
(ext:process-exit-code process))
(assert-equal "ls-link
"
(get-output-stream-string s))))))
;; Test that absolute paths work.
(do-test "/bin/ls")
;; Test that unspecfied path works. This depends on "ls" being
;; somewhere in PATH.
(do-test "ls")
;; Test that relative path to program works. (Issue #45).
(do-test (concatenate 'string
"./"
test-dir-name
"ls-link")))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment