Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
clpm
clpm
Commits
31f2af91
Commit
31f2af91
authored
Oct 15, 2021
by
Eric Timmons
Browse files
Add test for issue
#44
parent
9e6586f8
Changes
8
Hide whitespace changes
Inline
Side-by-side
clpm-test.asd
View file @
31f2af91
...
...
@@ -18,4 +18,5 @@
(
:file
"utils"
)
(
:file
"suite"
)
(
:file
"quicklisp-bundle"
)
(
:file
"global-context"
)
(
:file
"tests"
)))
test/configs/global/sources.conf
0 → 100644
View file @
31f2af91
;;; -*-
mode
:
common
-
lisp
; -*-
(
"quicklisp"
:
type
:
quicklisp
:
url
"http://localhost:8091/dist/quicklisp-test.txt"
)
test/global-context.lisp
0 → 100644
View file @
31f2af91
(
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
))))
test/global-context/editable-install/package.lisp
0 → 100644
View file @
31f2af91
(
defpackage
test
(
:use
:common-lisp
))
test/global-context/editable-install/test.asd
0 → 100644
View file @
31f2af91
(
defsystem
"test"
:description
"test system"
:depends-on
(
"alexandria"
)
:components
((
:file
"test"
)
(
:file
"package"
)))
test/global-context/editable-install/test.lisp
0 → 100644
View file @
31f2af91
(
in-package
:test
)
(
defun
hello-world
()
(
print
"Hello World"
))
test/suite.lisp
View file @
31f2af91
...
...
@@ -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
))
test/utils.lisp
0 → 100644
View file @
31f2af91
(
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"
))
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment