Fix tests.

error.lisp

@@ -4,6 +4,6 @@
            #:qlot-qlfile-error))
 (in-package #:qlot/error)
 
-(define-condition qlot-error (error) ())
+(define-condition qlot-error (simple-error) ())
 
 (define-condition qlot-qlfile-error (qlot-error) ())

install.lisp

@@ -38,7 +38,8 @@
                 #:directory-exists-p
                 #:directory-pathname-p
                 #:pathname-directory-pathname
-                #:delete-directory-tree)
+                #:delete-directory-tree
+                #:symbol-call)
   (:export #:install-quicklisp
            #:install-qlfile
            #:install-project))
@@ -200,7 +201,9 @@
 (defun apply-qlfile-to-qlhome (file qlhome &key ignore-lock)
   (let ((*tmp-directory* (uiop:ensure-directory-pathname (merge-pathnames (generate-random-string)
                                                                           (merge-pathnames #P"tmp/qlot/" qlhome))))
-        (all-sources (prepare-qlfile file :ignore-lock ignore-lock)))
+        (all-sources (prepare-qlfile file :ignore-lock ignore-lock))
+        (system-qlhome #+quicklisp ql:*quicklisp-home*)
+        (server-started-p nil))
 
     (with-quicklisp-home qlhome
       (flet ((install-all-releases (source)
@@ -228,30 +231,28 @@
                                                            (pathname-type script))
                                           #-unix (pathname-type script))))
                                  (uiop:copy-file script to)
-                                 #+sbcl (sb-posix:chmod to #o700))))))))))))
+                                 #+sbcl (sb-posix:chmod to #o700)))))))))))
+             (ensure-server-started ()
+               (unless server-started-p
+                 (with-quicklisp-home system-qlhome
+                   #+quicklisp (ql:quickload :qlot/server :silent t)
+                   #-quicklisp (asdf:load-system :qlot/server)
+                   (uiop:symbol-call :qlot/server :start-server all-sources)))))
         (dolist (source all-sources)
           (cond
             ((not (already-installed-p source))
-             #+quicklisp (ql:quickload :qlot/server :silent t)
-             #-quicklisp (asdf:load-system :qlot/server)
-             (with-package-functions :qlot/server (start-server stop-server)
-               (start-server all-sources)
-               (install-source source)
-               (install-all-releases source)
-               (stop-server)))
+             (ensure-server-started)
+             (install-source source)
+             (install-all-releases source))
             ((source-update-available-p source)
-             #+quicklisp (ql:quickload :qlot/server :silent t)
-             #-quicklisp (asdf:load-system :qlot/server)
-             (with-package-functions :qlot/server (start-server stop-server)
-               (start-server all-sources)
-               (prepare source)
-               (if (string= (source-dist-name source) "quicklisp")
-                   (with-package-functions :ql-dist (uninstall dist)
-                     (uninstall (dist "quicklisp"))
-                     (install-source source))
-                   (update-source source))
-               (install-all-releases source)
-               (stop-server)))
+             (prepare source)
+             (ensure-server-started)
+             (if (string= (source-dist-name source) "quicklisp")
+                 (with-package-functions :ql-dist (uninstall dist)
+                   (uninstall (dist "quicklisp"))
+                   (install-source source))
+                 (update-source source))
+             (install-all-releases source))
             (t (format t "~&Already have dist ~S version ~S.~%"
                        (source-dist-name source)
                        (source-version source))))
@@ -268,6 +269,9 @@
               (format t "~&Removing dist ~S.~%" (name dist))
               (uninstall dist))))))
 
+    (when server-started-p
+      (uiop:symbol-call :qlot/server :stop-server))
+
     ;; Quickload project systems.
     ;; NOTE: Commenting out because I'm not sure this is really required.
     ;;   All non-Quicklisp dists' releases should be installed above.

parser.lisp

@@ -37,7 +37,12 @@
     (destructuring-bind (source-type &rest args)
         (split-sequence #\Space line :remove-empty-subseqs t)
       (apply #'make-source
-             (find-source-class source-type)
+             (handler-case
+                 (find-source-class source-type)
+               (error (e)
+                 (error 'qlot-qlfile-error
+                        :format-control "~A"
+                        :format-arguments (list e))))
              (mapcar (lambda (arg)
                        (if (char= (aref arg 0) #\:)
                            (intern (string-upcase (subseq arg 1)) :keyword)
@@ -82,7 +87,7 @@
                 source)))))
 
 (defun prepare-qlfile (file &key ignore-lock)
-  (format t "~&Reading '~A'..." file)
+  (format t "~&Reading '~A'...~%" file)
   (let ((default-ql-source (make-source 'source-ql :all :latest))
         (lock-file (and (not ignore-lock)
                         (uiop:file-exists-p

qlot-test.asd

@@ -12,14 +12,19 @@
   :author "Eitaro Fukamachi"
   :license "MIT"
   :depends-on (:qlot
-               :qlot-install
+               :qlot/install
+               :qlot/source/git
+               :qlot/source/github
+               :qlot/source/ql
+               :qlot/source/http
+               :qlot/server
                :uiop
                :prove)
-  :components ((:module "t"
+  :components ((:module "tests"
                 :components
                 ((:test-file "parser")
                  (:test-file "server")
-                 (:test-file "qlot"))))
+                 (:test-file "main"))))
 
   :defsystem-depends-on (:prove-asdf)
   :perform (test-op :after (op c)

server.lisp

@@ -14,6 +14,8 @@
                 #:prepare-qlfile)
   (:import-from #:qlot/tmp
                 #:*tmp-directory*)
+  (:import-from #:qlot/util
+                #:with-quicklisp-home)
   (:import-from #:clack
                 #:clackup
                 #:stop)
@@ -78,12 +80,14 @@
                     (setf (gethash path route)
                           (make-route source action))))
                 (funcall (make-route source 'project.txt)))))
-      (lambda (env)
-        (let ((fn (gethash (getf env :path-info) route))
-              (*tmp-directory* tmp-directory))
-          (if fn
-              (funcall fn)
-              '(404 (:content-type "text/plain") ("Not Found"))))))))
+      (let ((qlhome #+quicklisp ql:*quicklisp-home*))
+        (lambda (env)
+          (with-quicklisp-home qlhome
+            (let ((fn (gethash (getf env :path-info) route))
+                  (*tmp-directory* tmp-directory))
+              (if fn
+                  (funcall fn)
+                  '(404 (:content-type "text/plain") ("Not Found"))))))))))
 
 (defgeneric start-server (sources)
   (:method ((sources list))

source/git.lisp

@@ -1,4 +1,5 @@
 (defpackage #:qlot/source/git
+  (:nicknames #:qlot.source.git)
   (:use #:cl
         #:qlot/source)
   (:import-from #:qlot/shell

t/qlot.lisp → tests/main.lisp

@@ -1,28 +1,22 @@
-#|
-  This file is a part of qlot project.
-  Copyright (c) 2014 Eitaro Fukamachi (e.arrows@gmail.com)
-|#
+(defpackage #:qlot/tests/main
+  (:use #:cl
+        #:qlot
+        #:prove)
+  (:import-from #:qlot/install
+                #:uninstall-all-dists)
+  (:import-from #:uiop
+                #:file-exists-p
+                #:delete-directory-tree
+                #:subdirectories))
+(in-package #:qlot/tests/main)
 
-(in-package :cl-user)
-(defpackage qlot-test
-  (:use :cl
-        :qlot
-        :prove)
-  (:import-from :qlot.install
-                :uninstall-all-dists)
-  (:import-from :uiop
-                :file-exists-p
-                :delete-directory-tree
-                :subdirectories))
-(in-package :qlot-test)
-
-(defparameter *tmp-directory* (asdf:system-relative-pathname :qlot #P"t/tmp/"))
+(defparameter *tmp-directory* (asdf:system-relative-pathname :qlot #P"tests/tmp/"))
 (uiop:delete-directory-tree *tmp-directory* :validate t :if-does-not-exist :ignore)
 (ensure-directories-exist *tmp-directory*)
 
-(let ((lock (asdf:system-relative-pathname :qlot #P"t/data/qlfile.lock"))
-      (lock2 (asdf:system-relative-pathname :qlot #P"t/data/qlfile2.lock"))
-      (lock3 (asdf:system-relative-pathname :qlot #P"t/data/qlfile3.lock")))
+(let ((lock (asdf:system-relative-pathname :qlot #P"tests/data/qlfile.lock"))
+      (lock2 (asdf:system-relative-pathname :qlot #P"tests/data/qlfile2.lock"))
+      (lock3 (asdf:system-relative-pathname :qlot #P"tests/data/qlfile3.lock")))
   (when (uiop:file-exists-p lock)
     (delete-file lock))
   (when (uiop:file-exists-p lock2)
@@ -35,13 +29,14 @@
 (let ((res (install-quicklisp (merge-pathnames #P"quicklisp/" *tmp-directory*))))
   (ok res "can install Quicklisp"))
 
-(uninstall-all-dists (merge-pathnames #P"quicklisp/" *tmp-directory*))
+(dolist (dir (uiop:subdirectories (merge-pathnames #P"quicklisp/dists/" *tmp-directory*)))
+  (uiop:delete-directory-tree dir :validate t :if-does-not-exist :ignore))
 
 (is (uiop:subdirectories (merge-pathnames #P"quicklisp/dists/" *tmp-directory*))
     '()
     "can uninstall all dists")
 
-(install (asdf:system-relative-pathname :qlot #P"t/data/qlfile")
+(install (asdf:system-relative-pathname :qlot #P"tests/data/qlfile")
          :quicklisp-home (merge-pathnames #P"quicklisp/" *tmp-directory*))
 
 (is (mapcar (lambda (path)
@@ -56,7 +51,7 @@
     :test #'equal
     "can install dists from qlfile")
 
-(update (asdf:system-relative-pathname :qlot #P"t/data/qlfile2")
+(update (asdf:system-relative-pathname :qlot #P"tests/data/qlfile2")
         :quicklisp-home (merge-pathnames #P"quicklisp/" *tmp-directory*))
 
 (is (mapcar (lambda (path)
@@ -69,7 +64,7 @@
     :test #'equal
     "can update dists from qlfile")
 
-(update (asdf:system-relative-pathname :qlot #P"t/data/qlfile3")
+(update (asdf:system-relative-pathname :qlot #P"tests/data/qlfile3")
         :quicklisp-home (merge-pathnames #P"quicklisp/" *tmp-directory*))
 
 (is (mapcar (lambda (path)

t/parser.lisp → tests/parser.lisp

@@ -1,26 +1,25 @@
-(in-package :cl-user)
-(defpackage qlot-test.parser
-  (:use :cl
-        :qlot.parser
-        :prove)
-  (:import-from :qlot.source
-                :source-project-name
-                :prepare)
-  (:import-from :qlot.source.ql
-                :source-ql
-                :source-ql-all
-                :source-ql-version)
-  (:import-from :qlot.source.git
-                :source-git)
-  (:import-from :qlot.parser
-                :parse-qlfile
-                :parse-qlfile-line)
-  (:import-from :qlot.error
-                :qlot-qlfile-error))
-(in-package :qlot-test.parser)
+(defpackage #:qlot/tests/parser
+  (:use #:cl
+        #:qlot/parser
+        #:prove)
+  (:import-from #:qlot/source
+                #:source-project-name
+                #:prepare)
+  (:import-from #:qlot/source/ql
+                #:source-ql
+                #:source-ql-all
+                #:source-ql-version)
+  (:import-from #:qlot/source/git
+                #:source-git)
+  (:import-from #:qlot/parser
+                #:parse-qlfile
+                #:parse-qlfile-line)
+  (:import-from #:qlot/error
+                #:qlot-qlfile-error))
+(in-package #:qlot/tests/parser)
 
 (defun test-qlfile (name)
-  (merge-pathnames name (asdf:system-relative-pathname :qlot #P"t/data/")))
+  (merge-pathnames name (asdf:system-relative-pathname :qlot #P"tests/data/")))
 
 (plan 17)
 

t/server.lisp → tests/server.lisp

@@ -1,31 +1,30 @@
-(in-package :cl-user)
-(defpackage qlot-test.server
-  (:use :cl
-        :qlot.server
-        :prove)
-  (:import-from :qlot.parser
-                :parse-qlfile)
-  (:import-from :qlot.tmp
-                :*tmp-directory*)
-  (:import-from :qlot.util
-                :generate-random-string)
-  (:import-from :uiop
-                :file-exists-p
-                :ensure-directory-pathname
-                :delete-directory-tree))
-(in-package :qlot-test.server)
+(defpackage #:qlot/tests/server
+  (:use #:cl
+        #:qlot/server
+        #:prove)
+  (:import-from #:qlot/parser
+                #:parse-qlfile)
+  (:import-from #:qlot/tmp
+                #:*tmp-directory*)
+  (:import-from #:qlot/util
+                #:generate-random-string)
+  (:import-from #:uiop
+                #:file-exists-p
+                #:ensure-directory-pathname
+                #:delete-directory-tree))
+(in-package #:qlot/tests/server)
 
 (plan 6)
 
-(let ((lock (asdf:system-relative-pathname :qlot #P"t/data/qlfile.lock")))
+(let ((lock (asdf:system-relative-pathname :qlot #P"tests/data/qlfile.lock")))
   (when (uiop:file-exists-p lock)
     (delete-file lock)))
 
 #+thread-support
-(let ((qlfile (asdf:system-relative-pathname :qlot #P"t/data/qlfile"))
+(let ((qlfile (asdf:system-relative-pathname :qlot #P"tests/data/qlfile"))
       (*tmp-directory* (uiop:ensure-directory-pathname
                         (merge-pathnames (generate-random-string)
-                                         (asdf:system-relative-pathname :qlot #P"t/tmp/qlot/")))))
+                                         (asdf:system-relative-pathname :qlot #P"tests/tmp/qlot/")))))
   (ensure-directories-exist *tmp-directory*)
   (diag "starting a server..")
   (start-server qlfile)