Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

156 lines (140 sloc) 7.455 kb
(in-package :asia)
(defun test ()
(format t "~%;;;; Testing ASIA FAD module...~%")
(asia-fad-test:test)
(format t "~%;;;; All FAD module tests passed.~%")
(setf *test-counter* 0)
(format t "~%;;;; Testing ASIA...~%")
(format t "~&;;; Utils~%")
(format t "~&;; with-unique-names~%")
(let* ((*gensym-counter* 0)
(syms (with-unique-names (foo bar quux)
(list foo bar quux))))
(assert* (null (some 'symbol-package syms)))
(assert* (equal (mapcar 'symbol-name syms) '("FOO0" "BAR1" "QUUX2"))))
(let* ((*gensym-counter* 0)
(syms (with-unique-names ((foo "_foo_") (bar -bar-) (quux #\q))
(list foo bar quux))))
(assert* (null (some 'symbol-package syms)))
(assert* (equal (mapcar 'symbol-name syms) '("_foo_0" "-BAR-1" "q2"))))
(format t "~&;; emptyp~%")
(assert* (not (emptyp '(1))))
(assert* (not (emptyp (let* ((cycle (list 1))) (nconc cycle cycle)))))
(assert* (emptyp '()))
(assert* (emptyp #()))
(assert* (not (emptyp #(1))))
(format t "~&;;; Base~%")
(format t "~&;; manifest-pathname~%")
(let* ((*project-manifest* (make-pathname :directory '(:absolute "tmp")))
(p (manifest-pathname "systems" "uffi" "a/project")))
(assert* (equal (pathname-directory p) '(:absolute "tmp" "systems" "uffi" "a")))
(assert* (equal (pathname-name p) "project"))
;; See SPLIT-NAME-TYPE in asdf.lisp
(assert* (eq (pathname-type p) (or #+(or ccl ecl gcl lispworks sbcl) :unspecific))))
(format t "~&;;; Project~%")
(format t "~&;; source-location~%")
(let* ((*source-location* (make-pathname :directory '(:absolute "tmp")))
(*project-manifest* nil))
(assert* (equal (source-location) *source-location*)))
(let* ((*source-location* nil)
(*project-manifest* (make-pathname :directory '(:absolute "tmp")))
(p (make-pathname :directory '(:absolute "tmp" "source"))))
(assert* (equal (source-location) p)))
(format t "~&;; project-name~%")
(multiple-value-bind (value error) (ignore-errors (project-name nil))
(assert* (null value))
(assert* (typep error 'error)))
(assert* (string= (project-name t) "t"))
(assert* (string= (project-name "t") "t"))
(assert* (string= (project-name "nil") "nil"))
(assert* (string= (project-name "cl-fad") "cl-fad"))
(assert* (string= (project-name "drakma") "drakma"))
(assert* (string= (project-name :t) "t"))
(assert* (string= (project-name :nil) "nil"))
(assert* (string= (project-name :cl-fad) "cl-fad"))
(assert* (string= (project-name :drakma) "drakma"))
(format t "~&;; project-directory~%")
(let* ((*source-location* (make-pathname :directory '(:absolute "tmp")))
(p (make-pathname :directory '(:absolute "tmp" "cl-fad"))))
(assert* (equal (project-directory "cl-fad") p)))
(let* ((*source-location* nil)
(*project-manifest* (make-pathname :directory '(:absolute "tmp")))
(p (make-pathname :directory '(:absolute "tmp" "source" "cl-fad"))))
(assert* (equal (project-directory "cl-fad") p)))
(format t "~&;;; Installer~%")
(format t "~&;; guess-backend~%")
(assert* (git-url-p "git://example.com/path"))
(assert* (git-url-p "git+ssh://example.com/path"))
(assert* (git-url-p "ssh+git://example.com/path"))
(assert* (git-url-p "http://example.com/git/path"))
(assert* (git-url-p "/git/path"))
(assert* (git-url-p "/root/git/path"))
(assert* (git-url-p "/path/project/git"))
(assert* (git-url-p "/path/project/git/"))
(assert* (git-url-p "http://example.com/path.git"))
(assert* (git-url-p "http://example.com/path.git/"))
(assert* (git-url-p "https://example.com/path.git"))
(assert* (git-url-p "https://example.com/path.git/"))
(assert* (git-url-p "ssh://example.com/path.git"))
(assert* (git-url-p "ssh://example.com/path.git/"))
(assert* (git-url-p "file:///path/project.git"))
(assert* (git-url-p "file:///path/project.git/"))
(assert* (git-url-p "/path/project.git"))
(assert* (git-url-p "/path/project.git/"))
(assert* (git-url-p "http://git.example.com/project"))
(assert* (git-url-p "https://git.example.com/project"))
(assert* (git-url-p "ssh://git.example.com/project"))
(assert* (git-url-p "git.example.com:project"))
(assert* (git-url-p "user@git.example.com:project"))
(assert* (git-url-p "git.example.com:/project"))
(assert* (git-url-p "user@git.example.com:/project"))
(assert* (svn-url-p "svn://example.com/path"))
(assert* (svn-url-p "http://example.com/svn/project"))
(assert* (svn-url-p "https://example.com/svn/project"))
(assert* (svn-url-p "http://svn.example.com/project"))
(assert* (svn-url-p "https://svn.example.com/project"))
(assert* (darcs-url-p "http://example.com/path/project/darcs"))
(assert* (darcs-url-p "https://example.com/path/project/darcs"))
(assert* (darcs-url-p "ssh://example.com/path/project/darcs"))
(assert* (darcs-url-p "http://example.com/path/project/darcs/"))
(assert* (darcs-url-p "https://example.com/path/project/darcs/"))
(assert* (darcs-url-p "ssh://example.com/path/project/darcs/"))
(assert* (darcs-url-p "http://example.com/path/darcs/project"))
(assert* (darcs-url-p "https://example.com/path/darcs/project"))
(assert* (darcs-url-p "ssh://example.com/path/darcs/project"))
(assert* (darcs-url-p "http://darcs.example.com/project"))
(assert* (darcs-url-p "https://darcs.example.com/project"))
(assert* (darcs-url-p "ssh://darcs.example.com/project"))
(assert* (darcs-url-p "darcs.example.com:project"))
(assert* (darcs-url-p "user@darcs.example.com:project"))
(assert* (darcs-url-p "darcs.example.com:/project"))
(assert* (darcs-url-p "user@darcs.example.com:/project"))
(assert* (cvs-url-p ":pserver:username:password@example.com:/path"))
(assert* (curl-url-p "http://example.com/path/project.tar.gz"))
(assert* (curl-url-p "https://example.com/path/project.tar.gz"))
(assert* (curl-url-p "ftp://example.com/path/project.tar.gz"))
(assert* (curl-url-p "ftps://example.com/path/project.tar.gz"))
(assert* (curl-url-p "sftp://example.com/path/project.tar.gz"))
(assert* (curl-url-p "file://example.com/path/project.tar.gz"))
(format t "~&;; project manifest test~%")
(let* ((*project-manifest* (system-relative-pathname :asia "t/manifest/" :type :directory))
(*source-location* nil))
(format t "~&;;; project-ignored-p~%")
(assert* (project-ignored-p :asdf))
(assert* (project-ignored-p :asia))
(assert* (project-ignored-p :ignored))
(format t "~&;;; project-installed-p~%")
(let* ((*source-location* (system-relative-pathname :asia "t/source/" :type :directory)))
(assert* (project-installed-p :asia-foo)))
(format t "~&;;; install-project~%")
(delete-directory-and-files (source-location) :if-does-not-exist :ignore)
(assert* (not (install-project "null-project" :url (lambda ()))))
(assert* (install-project "installer-test"))
(let* ((tmpdir (make-temp-pathname :type :directory))
(archive (location (list tmpdir (pathspec "asia-test-archive.tar" :type "gz")))))
(delete-directory-and-files tmpdir :if-does-not-exist :ignore)
(ensure-directories-exist tmpdir)
(run-shell-command "tar c -z -f ~A -C ~A asia-test-archive" archive
(system-relative-pathname :asia "t/" :type :directory))
(assert* (install-project "asia-test-archive" :url archive))))
(format t "~%;;;; All tests passed.~%"))
Jump to Line
Something went wrong with that request. Please try again.