Commit d9d1a48f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Simplify run-program on ECL

Undo some ugly workaround from 3d8764fc now that ECL fixed bug 149:
https://gitlab.com/embeddable-common-lisp/ecl/issues/149
parent 6b71a134
Loading
Loading
Loading
Loading
+77 −100
Original line number Diff line number Diff line
@@ -386,15 +386,7 @@ argument to pass to the internal RUN-PROGRAM"
    (etypecase specifier
      (null (or #+(or allegro lispworks) (null-device-pathname)))
      (string (parse-native-namestring specifier))
      (pathname
       #-ecl specifier
       #+ecl (let ((s (apply 'open specifier :direction
                             (ecase role
                               ((:input)
                                '(:input :if-does-not-exist :error))
                               ((:output :error-output)
                                '(:output :if-does-not-exist :create :if-exists :rename-and-delete))))))
               (values s s)))
      (pathname specifier)
      (stream specifier)
      ((eql :stream) :stream)
      ((eql :interactive)
@@ -417,12 +409,6 @@ argument to pass to the internal RUN-PROGRAM"
      (integer raw-exit-code) ; negative: signal
      (t -1)))

  (defun call-with-open-streams (streams thunk)
    (unwind-protect (funcall thunk) (dolist (s streams) (ignore-errors (close s)))))

  (defmacro with-open-streams ((streams) &body body)
    `(call-with-closing ,streams #'(lambda () ,@body)))

  (defun %run-program (command
                       &rest keys
                       &key input (if-input-does-not-exist :error)
@@ -443,28 +429,19 @@ It returns a process-info plist with possible keys:
    #-(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
    (progn command keys directory
           (error "run-program not available"))
    #+(or allegro clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
    (nest
     (let ((%command (%normalize-command command))
           #+ecl (close-me '())))
     (multiple-value-bind (%input #+ecl i-close)
         (%normalize-io-specifier input :input)
       #+ecl (when i-close (push i-close close-me)))
     (multiple-value-bind (%output #+ecl o-close)
         (%normalize-io-specifier output :output)
       #+ecl (when o-close (push o-close close-me)))
     (multiple-value-bind (%error-output #+ecl e-close)
         (%normalize-io-specifier error-output :error-output)
       #+ecl (when e-close (push e-close close-me)))
     #+(and allegro os-windows) (let ((interactive (%interactivep input output error-output))))
     (let ((process*
    #+(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
    (let* ((%command (%normalize-command command))
           (%input (%normalize-io-specifier input :input))
           (%output (%normalize-io-specifier output :output))
           (%error-output (%normalize-io-specifier error-output :error-output))
           (interactive (%interactivep input output error-output))
           (process*
             (nest
              #+clisp (progn
                        ;; clisp cannot redirect stderr, so check we don't.
                        ;; Also, since we now always return a code, we cannot use this code path
                        ;; if any of the input, output or error-output is :stream.
                        (assert (eq %error-output :terminal)))
              #+ecl (with-open-streams (close-me))
              #-(or allegro mkcl sbcl) (with-current-directory (directory))
              #+(or allegro clasp clisp ecl lispworks mkcl) (multiple-value-list)
              (apply
@@ -501,7 +478,7 @@ It returns a process-info plist with possible keys:
                #+mkcl `(:directory ,(native-namestring directory))
                #-sbcl keys
                #+sbcl (if directory keys (remove-plist-key :directory keys))))))
           (process-info-r ())))
           (process-info-r ()))
      (flet ((prop (key value) (push key process-info-r) (push value process-info-r)))
        #+allegro
        (cond