From 12acba0e60686e10aee82b00161e9879c8293060 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sat, 12 Oct 2013 14:39:51 -0400
Subject: [PATCH] Fix run-program on ccl/windows. More tweaks for
 allegro/windows.

---
 test/run-tests.sh            |  9 ++++++++-
 test/test-run-program.script |  4 ++--
 uiop/common-lisp.lisp        | 14 ++++++++++++++
 uiop/run-program.lisp        |  2 +-
 uiop/stream.lisp             |  6 +++++-
 5 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/test/run-tests.sh b/test/run-tests.sh
index 3d38b6d5..62974d3c 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -141,6 +141,11 @@ do_tests () {
   fi
 }
 
+case $(uname) in
+    CYGWIN*) os=windows ;;
+    *) os=unix ;;
+esac
+
 # terminate on error
 set -e
 
@@ -152,13 +157,15 @@ case "$lisp" in
     eval="--eval" ;;
   allegro)
     command="${ALLEGRO:-alisp}"
-    #flags="-q"
+    flags="-q"
     nodebug="-batch"
+    if [ "$os" = windows ] ; then nodebug="$nodebug +c" ; fi
     eval="-e" ;;
   allegromodern)
     command="${ALLEGROMODERN:-mlisp}"
     flags="-q"
     nodebug="-batch"
+    if [ "$os" = windows ] ; then nodebug="$nodebug +c" ; fi
     eval="-e" ;;
   ccl)
     command="${CCL:-ccl}"
diff --git a/test/test-run-program.script b/test/test-run-program.script
index cf0f1ee7..34f375b1 100644
--- a/test/test-run-program.script
+++ b/test/test-run-program.script
@@ -2,10 +2,10 @@
 (declaim (optimize (debug 3) (safety 3)))
 
 (DBG "Testing echo ok 1 via run-program as a list")
-(assert-equal '("ok 1") (run-program '("echo" "ok" "1") :output :lines))
+(assert-equal "ok 1" (run-program '("echo" "ok" "1") :output '(:string :stripped t)))
 
 (DBG "Testing echo ok 1 via run-program as a string")
-(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
+(assert-equal "ok 1" (run-program "echo ok 1" :output '(:string :stripped t)))
 
 ;; (unless (os-unix-p) (leave-test "The rest of this test is only supposed to work on Unix"))
 
diff --git a/uiop/common-lisp.lisp b/uiop/common-lisp.lisp
index 0c39cf52..abaf6742 100644
--- a/uiop/common-lisp.lisp
+++ b/uiop/common-lisp.lisp
@@ -46,6 +46,20 @@
     (setf excl:*warn-on-nested-reader-conditionals* nil))
   (setf *print-readably* nil))
 
+#+clozure
+(in-package :ccl)
+#+(and clozure windows-target)
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (unless (fboundp 'external-process-wait)
+    (in-development-mode
+     (defun external-process-wait (proc)
+       (when (external-process-pid proc))
+         (with-interrupts-enabled
+             (wait-on-semaphore (external-process-completed proc)))))))
+#+clozure
+(in-package :uiop/common-lisp)
+
+
 #+cormanlisp
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (deftype logical-pathname () nil)
diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp
index fcfa2515..26018d26 100644
--- a/uiop/run-program.lisp
+++ b/uiop/run-program.lisp
@@ -560,7 +560,7 @@ It returns a process-info plist with possible keys:
         (let ((process (getf process-info :process)))
           (when process
             ;; 1- wait
-            #+(and clozure os-unix) (ccl::external-process-wait process)
+            #+clozure (ccl::external-process-wait process)
             #+(or cmu scl) (ext:process-wait process)
             #+(and ecl os-unix) (ext:external-process-wait process)
             #+sbcl (sb-ext:process-wait process)
diff --git a/uiop/stream.lisp b/uiop/stream.lisp
index 27e2de54..3f98f3e1 100644
--- a/uiop/stream.lisp
+++ b/uiop/stream.lisp
@@ -364,13 +364,17 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE."
   (defun slurp-stream-lines (input &key count)
     "Read the contents of the INPUT stream as a list of lines, return those lines.
 
+Note: relies on the Lisp's READ-LINE, but additionally removes any remaining CR
+from the line-ending if the file or stream had CR+LF but Lisp only removed LF.
+
 Read no more than COUNT lines."
     (check-type count (or null integer))
     (with-open-stream (input input)
       (loop :for n :from 0
             :for l = (and (or (not count) (< n count))
                           (read-line input nil nil))
-            :while l :collect l)))
+            ;; stripln: to remove CR when the OS sends CRLF and Lisp only remove LF
+            :while l :collect (stripln l))))
 
   (defun slurp-stream-line (input &key (at 0))
     "Read the contents of the INPUT stream as a list of lines,
-- 
GitLab