cmucl: run-program broken with relative path

[pipping]

I'll look at sbcl 1.3.20, ccl 1.11, and cmucl 21b, and have each one call `sh -c "echo hi"` in two ways (with asdf 3.2.1). First, here's what works (an absolute path)

% sbcl --eval "(require :asdf)" --eval "(uiop:run-program '(\"/bin/sh\" \"-c\" \"echo hi\"))" --eval "(quit)"; echo $?
[...]
0
% ccl --eval "(require :asdf)" --eval "(uiop:run-program '(\"/bin/sh\" \"-c\" \"echo hi\"))" --eval "(quit)"; echo $?
0
% cmucl -eval "(require :asdf)" -eval "(uiop:run-program '(\"/bin/sh\" \"-c\" \"echo hi\"))" -eval "(quit)"; echo $?
[...]
0
%

But this does not work:

% ln -sf /bin/sh mysh
% sbcl --eval "(require :asdf)" --eval "(uiop:run-program '(\"./mysh\" \"-c\" \"echo hi\"))" --eval "(quit)"; echo $?
[...]
0
% ccl --eval "(require :asdf)" --eval "(uiop:run-program '(\"./mysh\" \"-c\" \"echo hi\"))" --eval "(quit)"; echo $?
0
% cmucl -eval "(require :asdf)" -eval "(uiop:run-program '(\"./mysh\" \"-c\" \"echo hi\"))" -eval "(quit)"; echo $?
[...]

Error in function RUN-PROGRAM: No such program: "./mysh"
   [Condition of type SIMPLE-ERROR]

Restarts:
  0: [ABORT] Skip remaining initializations.

Debug (type H for help)

(RUN-PROGRAM "./mysh" ("./mysh" "-c" "echo hi") :ENV NIL ...)
Source: Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
  target:code/run-program.lisp.
0]

[pipping (pipping)]

Issue persists (on cmu-21b__21b_unicode_-linux-x86):

Session 1

* (load "../asdf/build/asdf.lisp")
[..]

* (asdf:implementation-identifier)

"cmu-21b__21b_unicode_-linux-x86"
* (uiop:wait-process (uiop:launch-program '("/bin/ls" ".") :output :interactive))
ls_copy ls_link

0
* (uiop:wait-process (uiop:launch-program '("ls" ".") :output :interactive))
ls_copy ls_link

* (uiop:wait-process (uiop:launch-program '("ls_copy" ".") :output :interactive))

Error in function RUN-PROGRAM: No such program: "ls_copy"
   [Condition of type SIMPLE-ERROR]

Restarts:
  0: [ABORT] Return to Top-Level.

Debug (type H for help)

(RUN-PROGRAM "ls_copy" ("ls_copy" ".") :ENV NIL ...)
Source: Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
  target:code/run-program.lisp.
0] 0

* (uiop:wait-process (uiop:launch-program '("./ls_copy" ".") :output :interactive))

Error in function RUN-PROGRAM: No such program: "./ls_copy"
   [Condition of type SIMPLE-ERROR]

Restarts:
  0: [ABORT] Return to Top-Level.

Debug (type H for help)

(RUN-PROGRAM "./ls_copy" ("./ls_copy" ".") :ENV NIL ...)
Source: Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
  target:code/run-program.lisp.
0] 0

*

Session 2
===========================================================================================

* (load "../asdf/build/asdf.lisp")
[..]

* (asdf:implementation-identifier)

"sbcl-1.3.21-linux-x64"
* (uiop:wait-process (uiop:launch-program '("/bin/ls" ".") :output :interactive))
ls_copy ls_link

0
* (uiop:wait-process (uiop:launch-program '("ls" ".") :output :interactive))
ls_copy ls_link

0
* (uiop:wait-process (uiop:launch-program '("ls_copy" ".") :output :interactive))

debugger invoked on a SIMPLE-ERROR in thread
#<THREAD "main thread" RUNNING {100197EA03}>:
  Couldn't execute "ls_copy": No such file or directory

Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ABORT] Exit debugger, returning to top level.

(RUN-PROGRAM "ls_copy" (".") :ENV NIL :ENVIRONMENT NIL :WAIT NIL :SEARCH T :PTY NIL :INPUT NIL :IF-INPUT-DOES-NOT-EXIST :ERROR :OUTPUT T :IF-OUTPUT-EXISTS :APPEND :ERROR NIL :IF-ERROR-EXISTS :APPEND :STATUS-HOOK NIL :EXTERNAL-FORMAT :UTF-8 :DIRECTORY NIL)
0] 0

* (uiop:wait-process (uiop:launch-program '("./ls_copy" ".") :output :interactive))
ls_copy ls_link

0
*

[Faré (fahree)]

Maybe on some platforms, including cmucl, launch-program should ensure the pathname is absolute, at least if a relative directory is specified? I hope that doesn't mean we have to reimplement PATH processing, though.

[pipping (pipping)]

Well, I'm not sure if this should fix only cmucl or all implementations; either way, there's the output of a couple of runs of a different script:

### abcl-1.5.0-fasl43-linux-x64
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### acl-10.1-linux-x86
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### ccl-1.11-f96-linux-x86
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### cmu-20c_release-20c__20c_unicode_-linux-x86
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### cmu-21b__21b_unicode_-linux-x86
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### cmu-snapshot-2017-04-42-g7f3040a7e__21b_unicode_-linux-x86
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### ecl-16.1.3-linux-x64
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### ecl-16.1.3-f4feda8a-linux-x64
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### mkcl-1.1.10.19-2dbfa99-linux-x64
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### sbcl-1.3.21-linux-x64
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
### sbcl-1.3.21.149-9e3453954-linux-x64
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link
ls_copy ls_link

The script, meanwhile, added a categorisation of namestrings and corresponding adjusments:

(defun categorise (native-namestring)
  (let ((components (uiop:split-string native-namestring :separator "/")))
    (cond ((string-equal "" (first components))
           ;; could also use (uiop:absolute-pathname-p native-namestring)
           :absolute)
          ((equal 1 (length components))
           ;; now sure how to check with pathnames
           :single-word)
          (t
           ;; could also use (uiop:relative-pathname-p native-namestring)
           :relative))))

(defun fix (native-namestring)
  (ecase (categorise native-namestring)
         ((:absolute :single-word) native-namestring)
         (:relative (concatenate 'string (uiop:native-namestring (uiop:getcwd)) native-namestring))))

(let ()
  (format t "### ~a~%" (asdf:implementation-identifier))
  (force-output)

  (uiop:wait-process (uiop:launch-program (list (fix "/bin/ls") "tmp") :output :interactive))
  (uiop:wait-process (uiop:launch-program (list (fix "ls") "tmp") :output :interactive))
  (uiop:wait-process (uiop:launch-program (list (fix "./tmp/ls_link") "tmp") :output :interactive))
  (uiop:wait-process (uiop:launch-program (list (fix "tmp/ls_copy") "tmp") :output :interactive)))

Thoughts? (making the fix cmucl-specific would immediately rule out the counter-argument to the above-prposed like that "/" isn't portable because cmucl is *NIX-speific anyway).

[Faré (fahree)]

Unlike unix-namestring's, native-namestring's are not guaranteed to use / as separator. The separator might even vary with the host on a given implementation.

If the fix is CMUCL-specific then oh well, portability doesn't matter as much indeed. Though if it's a CMUCL bug, maybe we should discuss with the CMUCL maintainer and have it fixed on the implementation side.