cmucl-cvs September 2017

cmucl-cvs@common-lisp.net

1 participants
35 discussions

[Git][cmucl/cmucl][master] 5 commits: Fix #45: Handle relative paths in `run-program`
by Raymond Toy 30 Sep '17

30 Sep '17

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/39dff2ee5c2fc87e54e0f466… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/39dff2ee5c2fc87e54e0f466… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-fix-45-run-program-paths
by Raymond Toy 30 Sep '17

30 Sep '17

Raymond Toy pushed new branch rtoy-fix-45-run-program-paths at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-fix-45-run-program-pat… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update from logs
by Raymond Toy 23 Sep '17

23 Sep '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 39dff2ee by Raymond Toy at 2017-09-23T10:27:44-07:00 Update from logs - - - - - 1 changed file: - src/general-info/release-21c.txt Changes: ===================================== src/general-info/release-21c.txt ===================================== --- a/src/general-info/release-21c.txt +++ b/src/general-info/release-21c.txt @@ -31,14 +31,21 @@ New in this release: after accounting for time zones results in a positive value. (See ticket #36.) * CL:SLEEP no longer gets interrupted (See ticket #26.) + * Fix some compiler warnings and clean up funny indentation in + asin code. * Trac Tickets: * Gitlab tickets: * Ticket #36: encode-universal-time signals error * Ticket #26: The cmucl that never sleeps + * Ticket #40: Move heap space location for linux + * Ticket #41: Report proper process status + * Ticket #44: Add docstrings for process accessors * Other changes: + * Continuous integration added to build and test cmucl on every + check-in. This does a build on a Linux system. * Improvements to the PCL implementation of CLOS: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/39dff2ee5c2fc87e54e0f466c… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/39dff2ee5c2fc87e54e0f466c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Regenerate do to new docstrings
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 7f3040a7 by Raymond Toy at 2017-09-16T16:36:54-07:00 Regenerate do to new docstrings - - - - - 3 changed files: - src/i18n/locale/cmucl.pot - src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po - src/i18n/locale/ko/LC_MESSAGES/cmucl.po Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -13069,21 +13069,64 @@ msgid "\"~A\" is not a recognized time/date format." msgstr "" #: src/code/run-program.lisp -msgid "Return any available status information on child processed. " +msgid "List of process structures for all active processes." msgstr "" #: src/code/run-program.lisp -msgid "List of process structures for all active processes." +msgid "" +"Return the current status of process. The result is one of\n" +" :running,:stopped, :continued, :exited, :signaled." +msgstr "" + +#: src/code/run-program.lisp +msgid "Wait for PROC to quit running for some reason. Returns PROC." +msgstr "" + +#: src/code/run-program.lisp +msgid "PID of child process." msgstr "" #: src/code/run-program.lisp msgid "" -"Return the current status of process. The result is one of :running,\n" -" :stopped, :exited, :signaled." +"Exit code for the process if it is :exited; the termination signal\n" +" if it is :signaled; 0 if it is :stopped. It is undefined in all\n" +" other cases." msgstr "" #: src/code/run-program.lisp -msgid "Wait for PROC to quit running for some reason. Returns PROC." +msgid "Non-NIL if the process was terminated and a core image was dumped." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"The two-way stream connected to the child's Unix pty connection or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream to child's input or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream from child's output or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream from child's error output or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"The function to be called whenever process's changes status. This\n" +" function takes the process as a required argument. This is\n" +" setf'able." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"Returns annotations supplibed by users; it is setf'able. This is\n" +" available for users to associcate information with the process\n" +" without having to build a-lists or hash tables of process\n" +" structures." msgstr "" #: src/code/run-program.lisp ===================================== src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po ===================================== --- a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po @@ -18678,20 +18678,15 @@ msgid "\"~A\" is not a recognized time/date format." msgstr "\"~Away\" isway otnay away ecognizedray imetay/ateday ormatfay." #: src/code/run-program.lisp -msgid "Return any available status information on child processed. " -msgstr "" -"Eturnray anyway availableway tatussay informationway onway ildchay " -"ocessedpray. " - -#: src/code/run-program.lisp msgid "List of process structures for all active processes." msgstr "" "Istlay ofway ocesspray ucturesstray orfay allway activeway ocessespray." #: src/code/run-program.lisp +#, fuzzy msgid "" -"Return the current status of process. The result is one of :running,\n" -" :stopped, :exited, :signaled." +"Return the current status of process. The result is one of\n" +" :running,:stopped, :continued, :exited, :signaled." msgstr "" "Eturnray ethay urrentcay tatussay ofway ocesspray. Ethay esultray isway " "oneway ofway :unningray,\n" @@ -18704,6 +18699,56 @@ msgstr "" "PROC." #: src/code/run-program.lisp +#, fuzzy +msgid "PID of child process." +msgstr "Ouldcay otnay orkfay ildchay ocesspray: ~Away" + +#: src/code/run-program.lisp +msgid "" +"Exit code for the process if it is :exited; the termination signal\n" +" if it is :signaled; 0 if it is :stopped. It is undefined in all\n" +" other cases." +msgstr "" + +#: src/code/run-program.lisp +msgid "Non-NIL if the process was terminated and a core image was dumped." +msgstr "" + +#: src/code/run-program.lisp +#, fuzzy +msgid "The two-way stream connected to the child's Unix pty connection or NIL." +msgstr "" +"Ethay eamstray onnectedcay otay ethay tandardsay inputway (ilefay " +"escriptorday 0)." + +#: src/code/run-program.lisp +msgid "Stream to child's input or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream from child's output or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream from child's error output or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"The function to be called whenever process's changes status. This\n" +" function takes the process as a required argument. This is\n" +" setf'able." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"Returns annotations supplibed by users; it is setf'able. This is\n" +" available for users to associcate information with the process\n" +" without having to build a-lists or hash tables of process\n" +" structures." +msgstr "" + +#: src/code/run-program.lisp msgid "TIOCPGRP ioctl failed: ~S" msgstr "TIOCPGRP ioctlway ailedfay: ~S" @@ -30938,6 +30983,11 @@ msgstr "" "eplacedray ybay ethay\n" "Unicodeway eplacementray aracterchay." +#~ msgid "Return any available status information on child processed. " +#~ msgstr "" +#~ "Eturnray anyway availableway tatussay informationway onway ildchay " +#~ "ocessedpray. " + #~ msgid "Cound not create pipe: ~A" #~ msgstr "Oundcay otnay eatecray ipepay: ~Away" ===================================== src/i18n/locale/ko/LC_MESSAGES/cmucl.po ===================================== --- a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po @@ -13096,21 +13096,63 @@ msgid "\"~A\" is not a recognized time/date format." msgstr "" #: src/code/run-program.lisp -msgid "Return any available status information on child processed. " +msgid "List of process structures for all active processes." msgstr "" #: src/code/run-program.lisp -msgid "List of process structures for all active processes." +msgid "" +"Return the current status of process. The result is one of\n" +" :running,:stopped, :continued, :exited, :signaled." +msgstr "" + +#: src/code/run-program.lisp +msgid "Wait for PROC to quit running for some reason. Returns PROC." +msgstr "" + +#: src/code/run-program.lisp +msgid "PID of child process." msgstr "" #: src/code/run-program.lisp msgid "" -"Return the current status of process. The result is one of :running,\n" -" :stopped, :exited, :signaled." +"Exit code for the process if it is :exited; the termination signal\n" +" if it is :signaled; 0 if it is :stopped. It is undefined in all\n" +" other cases." msgstr "" #: src/code/run-program.lisp -msgid "Wait for PROC to quit running for some reason. Returns PROC." +msgid "Non-NIL if the process was terminated and a core image was dumped." +msgstr "" + +#: src/code/run-program.lisp +msgid "The two-way stream connected to the child's Unix pty connection or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream to child's input or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream from child's output or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "Stream from child's error output or NIL." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"The function to be called whenever process's changes status. This\n" +" function takes the process as a required argument. This is\n" +" setf'able." +msgstr "" + +#: src/code/run-program.lisp +msgid "" +"Returns annotations supplibed by users; it is setf'able. This is\n" +" available for users to associcate information with the process\n" +" without having to build a-lists or hash tables of process\n" +" structures." msgstr "" #: src/code/run-program.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/7f3040a7eafc6c5531417cd85… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/7f3040a7eafc6c5531417cd85… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #44: Add docstrings for process accessors
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ec29ec51 by Raymond Toy at 2017-09-16T15:23:32-07:00 Fix #44: Add docstrings for process accessors Adds docstrings for the exported process accessors: `process-pid`, `process-exit-code`, `process-core-dumped`, `process-pty`, `process-input`, `process-output`, `process-error`, `process-status-hook`, `process-plist`. - - - - - f99b8125 by Raymond Toy at 2017-09-16T23:29:58+00:00 Merge branch 'rtoy-fix-44-add-docstrings-process' into 'master' Fix #44: Add docstrings for process accessors Closes #44 See merge request !24 - - - - - 1 changed file: - src/code/run-program.lisp Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -75,8 +75,8 @@ ;;; PROCESS-STATUS -- Public. ;;; (defun process-status (proc) - "Return the current status of process. The result is one of :running, - :stopped, :exited, :signaled." + "Return the current status of process. The result is one of + :running,:stopped, :continued, :exited, :signaled." (declare (type process proc)) (get-processes-status-changes) (process-%status proc)) @@ -99,6 +99,32 @@ (system:serve-all-events 1)) proc) +;;; Add docstrings for the other public PROCESS accessors. +(setf (documentation 'process-pid 'function) + _N"PID of child process.") +(setf (documentation 'process-exit-code 'function) + _N"Exit code for the process if it is :exited; the termination signal + if it is :signaled; 0 if it is :stopped. It is undefined in all + other cases.") +(setf (documentation 'process-core-dumped 'function) + _N"Non-NIL if the process was terminated and a core image was dumped.") +(setf (documentation 'process-pty 'function) + _N"The two-way stream connected to the child's Unix pty connection or NIL.") +(setf (documentation 'process-input 'function) + _N"Stream to child's input or NIL.") +(setf (documentation 'process-output 'function) + _N"Stream from child's output or NIL.") +(setf (documentation 'process-error 'function) + _N"Stream from child's error output or NIL.") +(setf (documentation 'process-status-hook 'function) + _N"The function to be called whenever process's changes status. This + function takes the process as a required argument. This is + setf'able.") +(setf (documentation 'process-plist 'function) + _N"Returns annotations supplibed by users; it is setf'able. This is + available for users to associcate information with the process + without having to build a-lists or hash tables of process + structures.") #-hpux ;;; FIND-CURRENT-FOREGROUND-PROCESS -- internal View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/e1f12db958ab0af954c377a5… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/e1f12db958ab0af954c377a5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-fix-44-add-docstrings-process
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed new branch rtoy-fix-44-add-docstrings-process at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-fix-44-add-docstrings-… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Remove wait3 stuff
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e1f12db9 by Raymond Toy at 2017-09-16T14:54:10-07:00 Remove wait3 stuff `wait3` is removed along with alien routine and the constants. - - - - - 1 changed file: - src/code/run-program.lisp Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -27,58 +27,12 @@ process-close process-pid process-p)) -;;;; Import WAIT3 from unix. - -(alien:def-alien-routine ("wait3" c-wait3) c-call:int - (status c-call:int :out) - (options c-call:int) - (rusage c-call:int)) - (alien:def-alien-routine ("prog_status" c-prog-status) c-call:void (pid c-call:int :out) (what c-call:int :out) (code c-call:int :out) (corep c-call:int :out)) -(eval-when (load eval compile) - (defconstant wait-wnohang #-svr4 1 #+svr4 #o100) - (defconstant wait-wuntraced #-svr4 2 #+svr4 4) - (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced)) - -(defun wait3 (&optional do-not-hang check-for-stopped) - "Return any available status information on child processed. " - (multiple-value-bind (pid status) - (c-wait3 (logior (if do-not-hang - wait-wnohang - 0) - (if check-for-stopped - wait-wuntraced - 0)) - 0) - (cond ((or (minusp pid) - (zerop pid)) - nil) - ((eql (ldb (byte 8 0) status) - wait-wstopped) - (values pid - :stopped - (ldb (byte 8 8) status))) - ((zerop (ldb (byte 7 0) status)) - (values pid - :exited - (ldb (byte 8 8) status))) - (t - (let ((signal (ldb (byte 7 0) status))) - (values pid - (if (or (eql signal unix:sigstop) - (eql signal unix:sigtstp) - (eql signal unix:sigttin) - (eql signal unix:sigttou)) - :stopped - :signaled) - signal - (not (zerop (ldb (byte 1 7) status))))))))) - (defun prog-status () (multiple-value-bind (ret pid what code corep) (c-prog-status) @@ -89,7 +43,6 @@ code (not (zerop corep)))))) - ;;;; Process control stuff. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e1f12db958ab0af954c377a5b… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e1f12db958ab0af954c377a5b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Clean up prog_status
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 81e08ecb by Raymond Toy at 2017-09-16T14:49:33-07:00 Clean up prog_status - If `waidpid` returns 0 or -1, we should return. - Make the fprintf message a bit clearer on what's happening when we have some kind of status that we didn't handle. - - - - - 1 changed file: - src/lisp/runprog.c Changes: ===================================== src/lisp/runprog.c ===================================== --- a/src/lisp/runprog.c +++ b/src/lisp/runprog.c @@ -107,8 +107,7 @@ prog_status(pid_t* pid, int* what, int* code, int* corep) w = waitpid(-1, &status, WNOHANG | WUNTRACED | WCONTINUED); *pid = w; - if (w == -1) { - + if (w <= 0) { return; } @@ -129,7 +128,7 @@ prog_status(pid_t* pid, int* what, int* code, int* corep) *code = 0; *corep = 0; } else { - fprintf(stderr, "pid = %d, status = 0x%x\n", *pid, status); + fprintf(stderr, "Unhandled waidpid status: pid = %d, status = 0x%x\n", *pid, status); } return; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/81e08ecbdbbafb9ee29a4013b… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/81e08ecbdbbafb9ee29a4013b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 3 commits: Fix #41: Report proper process status
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f05cb10a by Raymond Toy at 2017-09-08T20:38:41-07:00 Fix #41: Report proper process status The main problem is that we weren't calling wait3 with WCONTINUED so that we would be signaled when the process continues. And we also need to check that result of wait call was WCONTINUED> Replace the wait3 routine with a C routine (prog_status) so we don't have to deal with the OS-specific flags. This function basically returns what the lisp function wait3 did. Use this function in GET-PROCESSES-STATUS-CHANGES. - runprog.c: - Add prog_status - run-program.lisp: - Use prog_status instead of wait3 - issues.lisp: - Add basic test - - - - - 65ce358d by Raymond Toy at 2017-09-15T22:50:47-07:00 Fix up minor issues in implementation - process-alive-p should return T for continued processes - Simplify prog-status slightly by making the status code array start :signaled instead of nil. - Update prog_status with enum to specify the codes to make it clearer what they mean and to make it clearer that it matches the expectations in prog-status. - - - - - 99ebe80c by Raymond Toy at 2017-09-16T21:02:40+00:00 Merge branch 'rtoy-fix-issue-41' into 'master' Fix #41: Report proper process status Closes #41 See merge request !23 - - - - - 3 changed files: - src/code/run-program.lisp - src/lisp/runprog.c - tests/issues.lisp Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -34,6 +34,12 @@ (options c-call:int) (rusage c-call:int)) +(alien:def-alien-routine ("prog_status" c-prog-status) c-call:void + (pid c-call:int :out) + (what c-call:int :out) + (code c-call:int :out) + (corep c-call:int :out)) + (eval-when (load eval compile) (defconstant wait-wnohang #-svr4 1 #+svr4 #o100) (defconstant wait-wuntraced #-svr4 2 #+svr4 4) @@ -73,6 +79,16 @@ signal (not (zerop (ldb (byte 1 7) status))))))))) +(defun prog-status () + (multiple-value-bind (ret pid what code corep) + (c-prog-status) + (declare (ignore ret)) + (when (plusp pid) + (values pid + (aref #(:signaled :stopped :continued :exited) what) + code + (not (zerop corep)))))) + ;;;; Process control stuff. @@ -201,7 +217,8 @@ (declare (type process proc)) (let ((status (process-status proc))) (if (or (eq status :running) - (eq status :stopped)) + (eq status :stopped) + (eq status :continued)) t nil))) @@ -235,7 +252,7 @@ (defun get-processes-status-changes () (loop (multiple-value-bind (pid what code core) - (wait3 t t) + (prog-status) (unless pid (return)) (let ((proc (find pid *active-processes* :key #'process-pid))) ===================================== src/lisp/runprog.c ===================================== --- a/src/lisp/runprog.c +++ b/src/lisp/runprog.c @@ -3,6 +3,8 @@ * */ +#include <stdio.h> + #include <sys/ioctl.h> #include <errno.h> #include <fcntl.h> @@ -10,6 +12,7 @@ #include <stdlib.h> #include <termios.h> #include <unistd.h> +#include <sys/wait.h> pid_t spawn(char *program, char *argv[], char *envp[], char *pty_name, @@ -70,3 +73,64 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name, /* The exec didn't work, flame out. */ exit(1); } + +/* + * Call waitpid and return appropriate information about what happened. + * + * what - int taking the values: + * 0 - ok + * 1 - signaled + * 2 - stopped + * 3 - continued + * 4 - exited + * code - the terminating signal + * core - true (non-zero) if a core was produced + */ + +/* + * Status codes. Must be in the same order as in ext::prog-status in + * run-program.lisp + */ +enum status_code { + SIGNALED, + STOPPED, + CONTINUED, + EXITED +}; + +void +prog_status(pid_t* pid, int* what, int* code, int* corep) +{ + pid_t w; + int status; + + w = waitpid(-1, &status, WNOHANG | WUNTRACED | WCONTINUED); + *pid = w; + + if (w == -1) { + + return; + } + + if (WIFEXITED(status)) { + *what = EXITED; + *code = WEXITSTATUS(status); + *corep = 0; + } else if (WIFSIGNALED(status)) { + *what = SIGNALED; + *code = WTERMSIG(status); + *corep = WCOREDUMP(status); + } else if (WIFSTOPPED(status)) { + *what = STOPPED; + *code = WSTOPSIG(status); + *corep = 0; + } else if (WIFCONTINUED(status)) { + *what = CONTINUED; + *code = 0; + *corep = 0; + } else { + fprintf(stderr, "pid = %d, status = 0x%x\n", *pid, status); + } + + return; +} ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -367,3 +367,41 @@ ;; get-universal-time only has an accuracy of 1 sec, just verify ;; more than 3 sec have elapsed. (assert-true (>= (- (get-universal-time) start-time) 3))))) + +(defun issue-41-tester (stop-signal) + (let* ((p (ext:run-program "/bin/sleep" '("5") :wait nil)) + (pid (ext:process-pid p))) + (flet ((external-kill (pid signal) + (ext:run-program "/usr/bin/env" + (list "kill" + (format nil "-~D" signal) + (format nil "~D" pid))))) + (assert-eql :running (ext:process-status p)) + + (external-kill pid stop-signal) + (sleep 1) + (assert-eql :stopped (ext:process-status p)) + + (external-kill pid unix:sigcont) + (sleep 1) + (assert-eql :continued (ext:process-status p)) + + (external-kill pid stop-signal) + (sleep 1) + (assert-eql :stopped (ext:process-status p)) + + (external-kill pid unix:sigcont) + (sleep 1) + (assert-eql :continued (ext:process-status p)) + + (sleep 5) + (assert-eql :exited (ext:process-status p))))) + +(define-test issue.41.1 + (:tag :issues) + (issue-41-tester unix:sigstop)) + +#+nil +(define-test issue.41.2 + (:tag :issues) + (issue-41-tester unix:sigtstp)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/4acd1d80b63cd3d639fe7291… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/4acd1d80b63cd3d639fe7291… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-fix-issue-41] Fix up minor issues in implementation
by Raymond Toy 16 Sep '17

16 Sep '17

Raymond Toy pushed to branch rtoy-fix-issue-41 at cmucl / cmucl Commits: 65ce358d by Raymond Toy at 2017-09-15T22:50:47-07:00 Fix up minor issues in implementation - process-alive-p should return T for continued processes - Simplify prog-status slightly by making the status code array start :signaled instead of nil. - Update prog_status with enum to specify the codes to make it clearer what they mean and to make it clearer that it matches the expectations in prog-status. - - - - - 2 changed files: - src/code/run-program.lisp - src/lisp/runprog.c Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -85,7 +85,7 @@ (declare (ignore ret)) (when (plusp pid) (values pid - (aref #(nil :signaled :stopped :continued :exited) what) + (aref #(:signaled :stopped :continued :exited) what) code (not (zerop corep)))))) @@ -217,7 +217,8 @@ (declare (type process proc)) (let ((status (process-status proc))) (if (or (eq status :running) - (eq status :stopped)) + (eq status :stopped) + (eq status :continued)) t nil))) ===================================== src/lisp/runprog.c ===================================== --- a/src/lisp/runprog.c +++ b/src/lisp/runprog.c @@ -3,6 +3,8 @@ * */ +#include <stdio.h> + #include <sys/ioctl.h> #include <errno.h> #include <fcntl.h> @@ -85,6 +87,17 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name, * core - true (non-zero) if a core was produced */ +/* + * Status codes. Must be in the same order as in ext::prog-status in + * run-program.lisp + */ +enum status_code { + SIGNALED, + STOPPED, + CONTINUED, + EXITED +}; + void prog_status(pid_t* pid, int* what, int* code, int* corep) { @@ -100,21 +113,23 @@ prog_status(pid_t* pid, int* what, int* code, int* corep) } if (WIFEXITED(status)) { - *what = 4; + *what = EXITED; *code = WEXITSTATUS(status); *corep = 0; } else if (WIFSIGNALED(status)) { - *what = 1; + *what = SIGNALED; *code = WTERMSIG(status); *corep = WCOREDUMP(status); } else if (WIFSTOPPED(status)) { - *what = 2; + *what = STOPPED; *code = WSTOPSIG(status); *corep = 0; } else if (WIFCONTINUED(status)) { - *what = 3; + *what = CONTINUED; *code = 0; *corep = 0; + } else { + fprintf(stderr, "pid = %d, status = 0x%x\n", *pid, status); } return; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/65ce358d918559662672cb1ae… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/65ce358d918559662672cb1ae… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs September 2017