[Git][cmucl/cmucl][master] 5 commits: Fix #45: Handle relative paths in `run-program`
Raymond Toy
rtoy at common-lisp.net
Sat Sep 30 21:31:18 UTC 2017
Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
12018284 by Raymond Toy at 2017-09-30T13:51:23-07:00
Fix #45: Handle relative paths in `run-program`
This is basically the solution proposed by Elias Pipping with a few
minor tweaks.
- In `run-program`, don't merge `program` with the "path:"
search-list. `spawn` will handle this.
- In `spawn`, if the first call to execve fails, instead of trying
"/bin/sh", use "/usr/bin/env" which will use the user's PATH if
necessary to find the program.
- - - - -
3665075a by Raymond Toy at 2017-09-30T14:18:55-07:00
Add test for issue #45
Add the tests given in issue #45.
- - - - -
00689a63 by Raymond Toy at 2017-09-30T14:20:44-07:00
Ignore test directory needed for issue.45 test
- - - - -
d2efe772 by Raymond Toy at 2017-09-30T14:21:03-07:00
Regenerated
- - - - -
ba357de8 by Raymond Toy at 2017-09-30T21:31:16+00:00
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
- - - - -
6 changed files:
- .gitignore
- bin/run-tests.sh
- src/code/run-program.lisp
- src/i18n/locale/cmucl.pot
- src/lisp/runprog.c
- tests/issues.lisp
Changes:
=====================================
.gitignore
=====================================
--- a/.gitignore
+++ b/.gitignore
@@ -1,35 +1,36 @@
-# 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 files generated by TeX
*.fasl
-*.sse2f
-*.x86f
*.ppcf
*.sparcf
-
-# Ignore files generated by TeX
+*.sse2f
+*.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/*.cdx
src/docs/cmu-user/*.cnd
src/docs/cmu-user/*.fdx
src/docs/cmu-user/*.fnd
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/*.tnd
src/docs/cmu-user/*.toc
src/docs/cmu-user/*.vdx
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
=====================================
bin/run-tests.sh
=====================================
--- a/bin/run-tests.sh
+++ b/bin/run-tests.sh
@@ -34,6 +34,12 @@ done
# Shift out the options
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
# No args so run all the tests
$LISP -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)'
=====================================
src/code/run-program.lisp
=====================================
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -528,10 +528,7 @@
;; info. Also, establish proc at this level so we can return it.
(let (*close-on-error* *close-in-parent* *handlers-installed* proc)
(unwind-protect
- (let ((pfile (unix-namestring (merge-pathnames program "path:") t t))
- (cookie (list 0)))
- (unless pfile
- (error (intl:gettext "No such program: ~S") program))
+ (let ((cookie (list 0)))
(multiple-value-bind
(stdin input-stream)
(get-descriptor-for input cookie :direction :input
@@ -570,7 +567,7 @@
env))
(let ((child-pid
(without-gcing
- (spawn pfile argv envp pty-name
+ (spawn program argv envp pty-name
stdin stdout stderr))))
(when (< child-pid 0)
(error (intl:gettext "Could not fork child process: ~A")
=====================================
src/i18n/locale/cmucl.pot
=====================================
--- a/src/i18n/locale/cmucl.pot
+++ b/src/i18n/locale/cmucl.pot
@@ -13251,10 +13251,6 @@ msgid "All args to program must be simple strings -- ~S."
msgstr ""
#: src/code/run-program.lisp
-msgid "No such program: ~S"
-msgstr ""
-
-#: src/code/run-program.lisp
msgid "Could not fork child process: ~A"
msgstr ""
=====================================
src/lisp/runprog.c
=====================================
--- a/src/lisp/runprog.c
+++ b/src/lisp/runprog.c
@@ -65,10 +65,10 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name,
/* Exec the program. */
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[-1] = "sh";
- execve("/bin/sh", argv - 1, envp);
+ argv[-1] = "/usr/bin/env";
+ execve("/usr/bin/env", argv - 1, envp);
/* The exec didn't work, flame out. */
exit(1);
=====================================
tests/issues.lisp
=====================================
--- a/tests/issues.lisp
+++ b/tests/issues.lisp
@@ -405,3 +405,33 @@
(define-test issue.41.2
(:tag :issues)
(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")))))
+
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/39dff2ee5c2fc87e54e0f466cfdf57ae209f2725...ba357de847c879e4edeb181f9cd97eb584932df5
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/39dff2ee5c2fc87e54e0f466cfdf57ae209f2725...ba357de847c879e4edeb181f9cd97eb584932df5
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20170930/aa7f300c/attachment-0001.html>
More information about the cmucl-cvs
mailing list