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

More test tweaking for Windows.

parent cd16fc40
Loading
Loading
Loading
Loading
+10 −8
Original line number Original line Diff line number Diff line
@@ -7,13 +7,15 @@
(setf *central-registry* `(,*test-directory* ,tmp))
(setf *central-registry* `(,*test-directory* ,tmp))


;; Don't rely on ln -s on Windows
;; Don't rely on ln -s on Windows
(unless (os-windows-p)
(cond
  (run-program
  ((os-unix-p)
   (format nil "ln -sf ~A ~A"
   (run-program
           (native-namestring asd)
    (format nil "ln -sf ~A ~A"
           (native-namestring asd2)))
            (native-namestring asd)
  (oos 'load-source-op 'test-multiple-too)
            (native-namestring asd2)))
  (assert (asymval :*file3* :test-package)))
   (oos 'load-source-op 'test-multiple-too))

  (t
   (oos 'load-source-op 'test-multiple)))
(assert (asymval :*file3* :test-package))
(load-system 'test-multiple-free)
(load-system 'test-multiple-free)
(assert (probe-file* file4))
(assert (probe-file* file4))
+15 −10
Original line number Original line Diff line number Diff line
@@ -25,21 +25,26 @@
  (unless (equal 0 (run-shell-command "./good-shell-command"))
  (unless (equal 0 (run-shell-command "./good-shell-command"))
    (error "Failed to capture exit status indicating shell command success.")))
    (error "Failed to capture exit status indicating shell command success.")))


;; On Windows, normalize away CRLF into jut the unixy LF.
(defun remove-cr (x) (remove (code-char 13) x))

(DBG "Testing awkward legacy output capture via run-shell-command")
(DBG "Testing awkward legacy output capture via run-shell-command")
(let ((ok1 (format nil "; $ echo ok 1~%ok 1~%")))
(let ((ok1 (format nil "; $ echo ok 1~%ok 1~%")))
  (assert-equal
  (assert-equal
   (with-output-to-string (s)
   (remove-cr
     (let ((*verbose-out* s))
    (with-output-to-string (s)
       (run-shell-command "echo ~A 1" "ok")))
      (let ((*verbose-out* s))
        (run-shell-command "echo ~A 1" "ok"))))
   ok1)
   ok1)
  #-ecl
  #-ecl
  (assert-equal
  (assert-equal
   (with-output-to-string (s)
   (remove-cr
     (let ((*verbose-out* t)
    (with-output-to-string (s)
           (*standard-output* s))
      (let ((*verbose-out* t)
       (let ((status (run-shell-command "echo ok ~D" 1)))
            (*standard-output* s))
         (unless (zerop status)
        (let ((status (run-shell-command "echo ok ~D" 1)))
           (error "Didn't get good exit status.")))))
          (unless (zerop status)
            (error "Didn't get good exit status."))))))
   ok1))
   ok1))


;; NB1: run-shell-command is deprecated. Use run-program instead.
;; NB1: run-shell-command is deprecated. Use run-program instead.
@@ -48,7 +53,7 @@
(assert-equal '("ok 1") (run-program "echo ok  1" :output :lines))
(assert-equal '("ok 1") (run-program "echo ok  1" :output :lines))
(assert-equal "ok  1" (run-program '("echo" "ok  1") :output :line))
(assert-equal "ok  1" (run-program '("echo" "ok  1") :output :line))
(assert-equal '(:ok 1) (run-program '("echo" ":ok  1") :output :forms))
(assert-equal '(:ok 1) (run-program '("echo" ":ok  1") :output :forms))
(assert-equal (format nil "ok  1~%") (run-program '("echo" "ok  1") :output :string))
(assert-equal (format nil "ok  1~%") (remove-cr (run-program '("echo" "ok  1") :output :string)))
;; this test checks for a problem there was in allegro -- :output :interactive
;; this test checks for a problem there was in allegro -- :output :interactive
;; would try to open T as a stream for INPUT.
;; would try to open T as a stream for INPUT.
(assert-equal 0 (run-program "true" :force-shell t :output :interactive))
(assert-equal 0 (run-program "true" :force-shell t :output :interactive))