From 460287c948c3d2443f699d6efe2f3e8a424283eb Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Wed, 7 Dec 2011 23:59:53 +0100
Subject: [PATCH] Added testing of quicklisp libraries

---
 src/tests/Makefile.in   |   9 +++-
 src/tests/config.lsp.in | 108 ++++++++++++++++++++++++++++++++++++++--
 2 files changed, 111 insertions(+), 6 deletions(-)

diff --git a/src/tests/Makefile.in b/src/tests/Makefile.in
index 727b05471..dda4e757c 100644
--- a/src/tests/Makefile.in
+++ b/src/tests/Makefile.in
@@ -2,7 +2,7 @@ ECL=ecl
 
 all: output.ecl/ansi.log output.ecl/regressions.log
 
-.PHONY: do-ansi do-regressions cleanup clean-sources update
+.PHONY: do-ansi do-regressions do-quicklisp cleanup clean-sources update
 
 output.ecl/ansi.log: config.lsp
 	$(MAKE) do-ansi
@@ -13,6 +13,8 @@ do-ansi: ansi-tests
 	$(ECL) -norc -load config.lsp -eval '(ecl-tests::run-ansi-tests)' -eval '(ext:quit)' < /dev/null
 do-regressions: regressions
 	$(ECL) -norc -load config.lsp -eval '(ecl-tests::run-regressions-tests)' -eval '(ext:quit)' < /dev/null
+do-quicklisp: quicklisp
+	$(ECL) -norc -load config.lsp -eval '(ecl-tests::run-quicklisp-tests)' -eval '(ext:quit)' < /dev/null
 
 #
 # Create directories
@@ -21,6 +23,8 @@ ansi-tests:
 	$(ECL) -norc -load config.lsp -eval '(ecl-tests::ensure-ansi-tests)' -eval '(ext:quit)' < /dev/null
 regressions:
 	$(ECL) -norc -load config.lsp -eval '(ecl-tests::ensure-regressions)' -eval '(ext:quit)' < /dev/null
+quicklisp:
+	$(ECL) -norc -load config.lsp -eval '(ecl-tests::ensure-quicklisp)' -eval '(ext:quit)' < /dev/null
 
 #
 # Test other implementations
@@ -43,4 +47,5 @@ clean-sources:
 distclean: clean-sources clean
 
 update: clean-sources
-	$(MAKE) ansi-tests regressions
+	$(MAKE) ansi-tests regressions quicklisp
+
diff --git a/src/tests/config.lsp.in b/src/tests/config.lsp.in
index 936f9a25e..d23b41774 100644
--- a/src/tests/config.lsp.in
+++ b/src/tests/config.lsp.in
@@ -18,8 +18,15 @@
 
 (defvar *here* (merge-pathnames "@builddir@/"))
 
-(defvar *test-image* (or (ext:getenv "TEST_IMAGE")
-			 (namestring (merge-pathnames "../bin/ecl" *here*))))
+(defvar *test-image* (or (ext:getenv "TEST_IMAGE") "ecl"))
+
+(defvar *test-image-args*
+  (cond ((search "ecl" *test-image*)
+	 '("-norc"))
+	((search "sbcl" *test-image*)
+	 '("--no-userinit" "--no-sysinit"))
+	(t
+	 '())))
 
 (defvar *test-name* (or (ext:getenv "TEST_NAME") "ecl"))
 
@@ -195,7 +202,7 @@
        (progn
 	 (ext:chdir *ansi-tests-sandbox*)
 	 (ext:run-program *test-image*
-			  '()
+			  *test-image-args*
 			  :input (merge-pathnames "doit.lsp" *ansi-tests-sandbox*)
 			  :output output
 			  :error :output))
@@ -212,9 +219,102 @@
        (progn
 	 (ext:chdir *regressions-sandbox*)
 	 (ext:run-program *test-image*
-			  '()
+			  *test-image-args*
 			  :input (merge-pathnames "doit.lsp" *regressions-sandbox*)
 			  :output output
 			  :error :output))
     (ext:chdir *here*)))
 
+(defvar *quicklisp-library-list*
+  '(trivial-features
+    alexandria
+    babel
+    cffi
+    cl-ppcre
+    cl-unicode
+    iterate
+    trivial-gray-streams
+    trivial-garbage
+    flexi-streams
+    lift
+    metabang-bind
+    swank
+    stefil
+    sqlite
+    chunga
+    cl+ssl
+    cl-base64
+    cl-fad
+    cl-python
+    md5
+    rfc2388
+    trivial-backtrace
+    trivial-gray-streams
+    usocket
+    hunchentoot))
+
+(defconstant +quicklisp-build-template+ "
+(require 'asdf)
+(setf (symbol-value (read-from-string \"asdf::*user-cache*\"))
+      (list ~s :implementation))
+(load ~s)
+(ql:use-only-quicklisp-systems)
+(handler-case
+  (progn
+    (ql:quickload ~s)
+    (princ \"ECL-BUILD-OK\"))
+  (serious-condition (c) (princ c)))
+(si::quit)
+")
+
+(defconstant +quicklisp-test-template+ "
+(require 'asdf)
+(setf (symbol-value (read-from-string \"asdf::*user-cache*\"))
+      (list ~s :implementation))
+(load ~s)
+(ql:use-only-quicklisp-systems)
+(handler-case
+  (progn
+    (ql:quickload ~s)
+    (princ \"ECL-BUILD-OK\")
+    (asdf:oos 'asdf:test-op :$name)
+    (princ \"ECL-TEST-OK\"))
+  (serious-condition (c) (princ c)))
+")
+
+(defun run-quicklisp-tests (&optional (output (merge-pathnames "quicklisp.log"
+							       *output-directory*)))
+  (mapcar #'delete-everything (directory (merge-pathnames "*/" *cache*)))
+  (let ((quicklisp-logs (merge-pathnames "quicklisp.logs/" *output-directory*)))
+    (labels ((build-or-test-job (name suffix template)
+	       (let* ((name (string-downcase name))
+		      (log-name (concatenate 'string name suffix))
+		      (build-log (ensure-directories-exist
+				  (merge-pathnames log-name quicklisp-logs))))
+		 (multiple-value-bind (stream status process)
+		     (ext:run-program *test-image*
+				      *test-image-args*
+				      :input :stream
+				      :output build-log
+				      :error :output
+				      :wait nil)
+		   (unwind-protect
+			(progn
+			  (format stream template
+				  (namestring *cache*)
+				  (namestring *quicklisp-setup-file*)
+				  name)
+			  (format t template
+				  (namestring *cache*)
+				  (namestring *quicklisp-setup-file*)
+				  name)
+			  (force-output stream))
+		     (close stream)
+		     (ext:external-process-wait process t)
+		     ))))
+	     (build-job (name)
+	       (build-or-test-job name "-build.log" +quicklisp-build-template+))
+	     (test-job (name)
+	       (build-or-test-job name "-test.log" +quicklisp-test-template+)))
+      (mapc #'build-job *quicklisp-library-list*)
+      (mapc #'test-job *quicklisp-library-list*))))