Commit 1fa1f7a6 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'bug/ecl-system-output' into 'master'

Bug fix: Avoid ext:system on ECL

ext:system is a wrapper around ext:run-program that forces :output  nil, which is not something we want. See also https://bugs.launchpad.net/asdf/+bug/1638870

See merge request !48
parents 077a4616 772330cd
Loading
Loading
Loading
Loading
+0 −7
Original line number Original line Diff line number Diff line
@@ -24,13 +24,6 @@
      (leave-test
      (leave-test
       "This test is not meant to be run on versions of CMU CL that predate 21B" 0))))
       "This test is not meant to be run on versions of CMU CL that predate 21B" 0))))


#+ecl
(unless (version-satisfies
         (lisp-implementation-version)
         "16.1.2")
  (leave-test
   "This test is not meant to be run on versions of ECL that predate 16.1.2" 0))

#+mkcl
#+mkcl
(unless (version-satisfies (lisp-implementation-version) "1.1.10")
(unless (version-satisfies (lisp-implementation-version) "1.1.10")
  (leave-test
  (leave-test
+33 −28
Original line number Original line Diff line number Diff line
@@ -965,17 +965,17 @@ or :error-output."
      (string
      (string
       (os-cond
       (os-cond
        ((os-windows-p)
        ((os-windows-p)
         #+(or allegro clisp)
         #+(or allegro clisp ecl)
         (strcat (%cmd-shell-pathname) " /c " command)
         (strcat (%cmd-shell-pathname) " /c " command)
         #-(or allegro clisp) command)
         #-(or allegro clisp ecl) command)
        (t command)))
        (t command)))
      (list (escape-shell-command
      (list (escape-shell-command
             (os-cond
             (os-cond
              ((os-unix-p) (cons "exec" command))
              ((os-unix-p) (cons "exec" command))
              ((os-windows-p)
              ((os-windows-p)
               #+(or allegro sbcl clisp)
               #+(or allegro clisp ecl sbcl)
               (cons (%cmd-shell-pathname) (cons "/c" command))
               (cons (%cmd-shell-pathname) (cons "/c" command))
               #-(or allegro sbcl clisp) command)
               #-(or allegro clisp ecl sbcl) command)
              (t command))))))
              (t command))))))


  (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
  (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
@@ -1012,18 +1012,28 @@ or :error-output."
                                       error-output if-error-output-exists
                                       error-output if-error-output-exists
                                       &allow-other-keys)
                                       &allow-other-keys)
    "A portable abstraction of a low-level call to libc's system()."
    "A portable abstraction of a low-level call to libc's system()."
    (declare (ignorable directory keys))
    (declare (ignorable keys directory input if-input-does-not-exist output
                        if-output-exists error-output if-error-output-exists))
    #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
    (let (#+(or abcl ecl mkcl) (version (parse-version (lisp-implementation-version))))
      (nest
       #+abcl (unless (lexicographic< '< version '(1 4 0)))
       #+ecl (unless (lexicographic<= '< version '(16 0 0)))
       #+mkcl (unless (lexicographic<= '< version '(1 1 9)))
       (return-from %system
         (wait-process
          (apply 'launch-program (%normalize-system-command command) keys)))))
    #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
    (let ((%command (%redirected-system-command command input output error-output directory)))
      ;; see comments for these functions
      ;; see comments for these functions
      (%handle-if-does-not-exist input if-input-does-not-exist)
      (%handle-if-does-not-exist input if-input-does-not-exist)
      (%handle-if-exists output if-output-exists)
      (%handle-if-exists output if-output-exists)
      (%handle-if-exists error-output if-error-output-exists)
      (%handle-if-exists error-output if-error-output-exists)
    #+(or allegro clozure cmucl (and lispworks os-unix) sbcl scl)
      #+abcl (ext:run-shell-command %command)
    (wait-process
      #+(or clasp ecl) (let ((*standard-input* *stdin*)
     (apply 'launch-program (%normalize-system-command command) :wait t keys))
                             (*standard-output* *stdout*)
    #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
                             (*error-output* *stderr*))
    (let ((%command (%redirected-system-command command input output error-output directory)))
                         (ext:system %command))
      #+(and lispworks os-windows)
      (system:call-system %command :current-directory directory :wait t)
      #+clisp
      #+clisp
      (let ((raw-exit-code
      (let ((raw-exit-code
             (or
             (or
@@ -1034,19 +1044,14 @@ or :error-output."
        (if (minusp raw-exit-code)
        (if (minusp raw-exit-code)
            (- 128 raw-exit-code)
            (- 128 raw-exit-code)
            raw-exit-code))
            raw-exit-code))
      #-(or clisp (and lispworks os-windows))
      (with-current-directory ((os-cond ((not (os-unix-p)) directory)))
        #+abcl (ext:run-shell-command %command) ;; FIXME: deprecated
      #+cormanlisp (win32:system %command)
      #+cormanlisp (win32:system %command)
        #+(or clasp ecl) (let ((*standard-input* *stdin*)
                               (*standard-output* *stdout*)
                               (*error-output* *stderr*))
                           (ext:system %command))
      #+gcl (system:system %command)
      #+gcl (system:system %command)
      #+genera (not-implemented-error '%system)
      #+genera (not-implemented-error '%system)
      #+(and lispworks os-windows)
      (system:call-system %command :current-directory directory :wait t)
      #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
      #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
      #+mkcl (mkcl:system %command)
      #+mkcl (mkcl:system %command)
        #+xcl (system:%run-shell-command %command))))
      #+xcl (system:%run-shell-command %command)))


  (defun %use-system (command &rest keys
  (defun %use-system (command &rest keys
                      &key input output error-output ignore-error-status &allow-other-keys)
                      &key input output error-output ignore-error-status &allow-other-keys)
@@ -1153,7 +1158,7 @@ or an indication of failure via the EXIT-CODE of the process"
                   #+(or clasp clisp) t
                   #+(or clasp clisp) t
                   ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program
                   ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program
                   #+ecl #.(if-let (ver (parse-version (lisp-implementation-version)))
                   #+ecl #.(if-let (ver (parse-version (lisp-implementation-version)))
                                   (lexicographic<= '< ver '(16 0 1)))
                                   (lexicographic<= '< ver '(16 0 0)))
                   #+(and lispworks os-unix) (%interactivep input output error-output)
                   #+(and lispworks os-unix) (%interactivep input output error-output)
                   #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl) t)
                   #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl) t)
               '%use-system '%use-launch-program)
               '%use-system '%use-launch-program)