Commit 31f2af91 authored by Eric Timmons's avatar Eric Timmons
Browse files

Add test for issue #44

parent 9e6586f8
......@@ -18,4 +18,5 @@
(:file "utils")
(:file "suite")
(:file "quicklisp-bundle")
(:file "global-context")
(:file "tests")))
;;; -*- mode: common-lisp; -*-
("quicklisp"
:type :quicklisp
:url "http://localhost:8091/dist/quicklisp-test.txt")
(in-package #:clpm-test)
(para:define-test global-context-editable-install
(uiop:with-current-directory ((asdf:system-relative-pathname :clpm "test/global-context/editable-install/"))
(with-clpm-env (:config-dir :global :data-dir data-dir)
;;(break "~S" data-dir)
(clpm '("sync" "-VV")
:output :interactive
:error-output :interactive)
(clpm '("install" "-y" "--asd" "test.asd")
:output :interactive
:error-output :interactive)
(clpm '("exec"
"--"
"sbcl" "--non-interactive" "--no-userinit" "--no-sysinit"
"--eval" "(require :asdf)"
"--eval" "(asdf:load-system :test)"
"--quit")
:output :interactive
:error-output :interactive))))
(defpackage test
(:use :common-lisp))
(defsystem "test"
:description "test system"
:depends-on ("alexandria")
:components ((:file "test")
(:file "package")))
(in-package :test)
(defun hello-world ()
(print "Hello World"))
......@@ -11,15 +11,25 @@
:output output :error-output error-output
(run-program-augment-env-args *clpm-env*)))
(defun call-with-clpm-env (thunk)
(defun call-with-clpm-env (thunk &key config-dir)
(with-temporary-directory (cache-dir :prefix "clpm-test-cache")
(with-temporary-directory (data-dir :prefix "clpm-test-data")
(let ((*clpm-env* (list (cons "CLPM_DATA_DIR" (uiop:native-namestring data-dir))
(cons "CLPM_CACHE_DIR" (uiop:native-namestring cache-dir)))))
(cons "CLPM_CACHE_DIR" (uiop:native-namestring cache-dir))
(cons "CLPM_GROVEL_SANDBOX_TYPE" "nil"))))
(when (keywordp config-dir)
(push (cons "CLPM_CONFIG_DIRS" (uiop:native-namestring
(asdf:system-relative-pathname
:clpm
(concatenate 'string "test/configs/"
(string-downcase config-dir)
"/"))))
*clpm-env*))
(funcall thunk :cache-dir cache-dir :data-dir data-dir)))))
(defmacro with-clpm-env ((&key (cache-dir (gensym)) (data-dir (gensym)))
(defmacro with-clpm-env ((&key (cache-dir (gensym)) (data-dir (gensym)) config-dir)
&body body)
`(call-with-clpm-env (lambda (&key ((:cache-dir ,cache-dir)) ((:data-dir ,data-dir)))
(declare (ignorable ,cache-dir ,data-dir))
,@body)))
,@body)
:config-dir ,config-dir))
(in-package #:clpm-test)
(defparameter *mkdtemp-random-bits* (* 8 4))
(defun mkdtemp (prefix &key (directory (uiop:temporary-directory)))
"Make a temporary directory and return its pathname. This is not a secure
implementation, but it is portable."
(loop
:for suffix := (random (ash 1 *mkdtemp-random-bits*))
:for name := (format nil "~A~X" prefix suffix)
:for pn := (uiop:ensure-directory-pathname (merge-pathnames name directory))
:do
(multiple-value-bind (pathspec createdp)
(ensure-directories-exist pn :mode #o700 :allow-other-keys t)
(declare (ignore pathspec))
(when createdp
(return pn)))))
(defun call-with-temporary-directory (thunk &key (prefix "clpm-test-")
(directory (uiop:temporary-directory)))
(let ((dir (mkdtemp prefix :directory directory)))
(unwind-protect
(funcall thunk dir)
(uiop:delete-directory-tree dir :validate t))))
(defmacro with-temporary-directory ((var &rest args
&key prefix
directory)
&body body)
(declare (ignore prefix directory))
`(call-with-temporary-directory
(lambda (,var)
,@body)
,@args))
#+sbcl
(defun posix-environment-alist ()
"Returns an alist representing the environment variables."
(let ((out nil))
(dolist (pair-string (sb-ext:posix-environ))
(let* ((pos-of-= (position #\= pair-string))
(name (subseq pair-string 0 pos-of-=))
(value (subseq pair-string (1+ pos-of-=))))
(push (cons name value) out)))
(nreverse out)))
#-sbcl
(defun posix-environment-alist ()
"Returns an alist representing the environemnt variables."
(error "Not implemented"))
#+sbcl
(defun run-program-augment-env-args (new-env-alist)
"Given an alist of environment variables, return a list of arguments suitable
for ~uiop:{launch/run}-program~ to set the augmented environment for the child
process."
(let ((env (posix-environment-alist)))
(dolist (pair new-env-alist)
(destructuring-bind (name . value) pair
(setf (alex:assoc-value env name :test #'equal) value)))
(list :environment
(mapcar (lambda (c)
(concatenate 'string (car c) "=" (cdr c)))
env))))
#+ccl
(defun run-program-augment-env-args (new-env-alist)
(list :env new-env-alist))
#-(or sbcl ccl)
(defun run-program-augment-env-args (new-env-alist)
(error "not implemented"))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment