From 5c9726e5625c87640a81659f068a85be2494ad1f Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sun, 13 Apr 2014 13:48:55 -0400
Subject: [PATCH] Don't use :interactive in test-program, it can really suck on
 LispWorks / Windows. Instead, refactor how we call make-hello-world.

---
 test/make-hello-world.lisp |  5 +++++
 test/test-program.script   | 35 ++++++++++++++++-------------------
 2 files changed, 21 insertions(+), 19 deletions(-)

diff --git a/test/make-hello-world.lisp b/test/make-hello-world.lisp
index bc312690..11bef3ad 100644
--- a/test/make-hello-world.lisp
+++ b/test/make-hello-world.lisp
@@ -10,6 +10,11 @@
 
 (asdf-test::frob-packages)
 
+(println "This is make-hello-world, testing its standard-output.") ; *standard-output*
+(println "This is make-hello-world, testing its error-output." *error-output*)
+(println "This is make-hello-world, testing its stdout." *stdout*)
+(println "This is make-hello-world, testing its stderr." *stderr*)
+
 #+mkcl
 (defun add-mkcl-dll (pathname)
   ;; make sure mkcl-X.X.X.dll is the same directory as the executable
diff --git a/test/test-program.script b/test/test-program.script
index a7702d57..13766fce 100644
--- a/test/test-program.script
+++ b/test/test-program.script
@@ -28,20 +28,26 @@
 ;; Disable any user source registry.
 (initialize-source-registry `(:source-registry :ignore-inherited-configuration))
 
+(defun make-hello-world (kind)
+  (assert-equal
+   0
+   (nth-value 2
+    (run-program
+     (symbol-call
+      #+allegro :lisp-path #+allegro *lisp*
+      :lisp-invocation :lisp-invocation-arglist
+      :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
+      :eval (format nil "(asdf-test::make-hello-~a)" kind))
+     :input nil :ignore-error-status t
+     :output (list *standard-output* :linewise t :prefix "stdout: ")
+     :error-output (list *error-output* :linewise t :prefix "stderr: ")))))
+
 (DBG "test image-op")
 (defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example)))
 (assert (absolute-pathname-p img))
 (delete-file-if-exists img)
 (DBG "- first create an executable image")
-(assert-equal
- (nth-value 2
-  (run-program
-   (symbol-call :lisp-invocation :lisp-invocation-arglist
-                #+allegro :lisp-path #+allegro *lisp*
-                :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
-                :eval "(asdf-test::make-hello-image)")
-   :output :interactive :error-output :interactive :input nil))
- 0)
+(make-hello-world 'image)
 (assert (probe-file* img) () "Can't find image file ~S" img)
 
 (DBG "- then, use it")
@@ -85,16 +91,7 @@
 (assert (absolute-pathname-p exe))
 (delete-file-if-exists exe)
 (DBG "- first, create the standalone program")
-(assert-equal
- (nth-value 2
-  (run-program
-   (symbol-call :lisp-invocation :lisp-invocation-arglist
-                #+allegro :lisp-path #+allegro *lisp*
-                :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
-                :eval "(asdf-test::make-hello-program)")
-   :output :interactive :error-output :interactive :input nil))
- 0)
-
+(make-hello-world 'program)
 (assert (probe-file* exe) () "Can't find executable file ~S" exe)
 
 (DBG "- use that")
-- 
GitLab