Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Pascal J. Bourguignon
asdf
Commits
7c184ec6
Commit
7c184ec6
authored
Jan 27, 2010
by
Rommel M. Martinez
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Updated source-registry tests
parent
7e34af2c
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
51 additions
and
113 deletions
+51
-113
.gitignore
.gitignore
+1
-0
test/run-tests.sh
test/run-tests.sh
+11
-1
test/test-source-registry.s
test/test-source-registry.s
+39
-112
No files found.
.gitignore
View file @
7c184ec6
...
...
@@ -7,6 +7,7 @@ website/changelog.xml
# Test stuff
test/results/
test/tmp/
# We build these at various stages in the make process
LICENSE
...
...
test/run-tests.sh
View file @
7c184ec6
...
...
@@ -5,7 +5,8 @@
# - quit with exit status 0 on getting eof
# - quit with exit status >0 if an unhandled error occurs
export
CL_SOURCE_REGISTRY
=
$PWD
export
TEST_DIR
=
"
$PWD
/tmp/"
export
CL_SOURCE_REGISTRY
=
"
$TEST_DIR
/dir1/:
$TEST_DIR
/dir2//"
if
[
x
"
$1
"
=
"xhelp"
]
;
then
echo
"
$0
[lisp invocation] [scripts-regex]"
...
...
@@ -105,6 +106,15 @@ fi
# do_tests "/usr/bin/lisp -batch -noinit" x86f
#fi
create_asds
()
{
mkdir
-p
tmp/
{
dir1,dir2/
{
dir3,dir4
}}
for
i
in
`
find tmp |
sed
-e
'1d'
`
;
do
touch
"
$i
"
/test.asd
;
done
}
clean_up
()
{
rm
-rf
tmp
}
if
[
-z
"
$command
"
]
;
then
echo
"Error: cannot find or do not know how to run Lisp named
$lisp
"
...
...
test/test-source-registry.s
View file @
7c184ec6
...
...
@@ -2,120 +2,47 @@
(
load
"../
asdf
")
;; TODO:
;; - test for conditions
;; - use with-env for CL_SOURCE_REGISTRY
;; - write clean-up procedures, if needed
;; - test for directories
;; - test for correct chaining of inheritance
(
eval
-
when
(:
execute
:
compile
-
toplevel
:
load
-
toplevel
)
(
require
:
sb
-
posix
))
(
defun
pathname
->
directory
(
pathname
)
(
make
-
pathname
:
directory
(
append
(
pathname
-
directory
pathname
)
(
list
(
file
-
namestring
pathname
)))
:
name
nil
:
type
nil
:
defaults
(
pathname
pathname
)))
(
def
package
:
test
-
source
-
registry
(
:
use
#
:
cl
#
:
asdf
))
(
def
var
*
test
-
directory
*
(
pathname
->
directory
(
getenv
"TEST_DIR"
)
))
(
in
-
package
:
test
-
source
-
registry
)
(
defun
under
-
test
-
directory
(
path
&
optional
(
defaults
*
test
-
directory
*))
(
merge
-
pathnames
path
defaults
))
(
defun
getenv
(
x
)
#+
sbcl
(
sb
-
posix
:
getenv
x
))
(
defun
setenv
(
x
v
)
#+
sbcl
(
sb
-
posix
:
putenv
(
concatenate
'string x "=" v))
v
)
(
defmacro
with
-
gensyms
((&
rest
names
)
&b
ody
body
)
`(
let
,(
loop
for
n
in
names
collect
`
(,
n
(
gensym
)))
,@
body
))
(
defmacro
with
-
env
((&
rest
kv
)
&b
ody
body
)
(
let
((
temps
(
loop
:
for
i
:
upto
(
length
kv
)
:
collect
(
gensym
)))
(
keys
(
mapcar
#
'(lambda (x) (first x)) kv)))
(
flet
((
gen
-
getenvs
()
(
mapcar
#
'(lambda (x y)
`(,
y
(
getenv
,
x
)))
keys
temps
))
(
gen
-
setenvs
()
(
mapcar
#
'(lambda (x y) `(setenv ,y ,x))
temps
keys
)))
`(
let
,(
gen
-
getenvs
)
(
unwind
-
protect
(
progn
,@(
loop
:
for
(
k
v
)
:
in
kv
:
collect
`
(
setenv
,
k
,
v
))
,@
body
)
(
progn
,
@
(
gen
-
setenvs
)))))))
(
defun
make
-
temporary
-
directory
()
(
let
((
str
(
with
-
output
-
to
-
string
(
s
)
(
sb
-
ext
:
run
-
program
"mktemp"
'("-d" "-u") :search t :output s))))
(
concatenate
'string
(
string
-
trim
'(#\newline) str) "/")))
(
defvar
*
base
-
directory
*
(
make
-
temporary
-
directory
))
(
defun
home
-
directory
(&
optional
(
base
*
base
-
directory
*))
(
let
((
s
(
namestring
(
user
-
homedir
-
pathname
))))
(
merge
-
pathnames
(
subseq
s
1
(
length
s
))
base
)))
(
defun
system
-
directory
(&
optional
(
base
*
base
-
directory
*))
(
merge
-
pathnames
"etc/"
base
))
(
defun
tmp
-
directory
(&
optional
(
base
*
base
-
directory
*))
(
merge
-
pathnames
"tmp/"
base
))
(
defun
home
-
source
-
registry
()
(
asdf
::
source
-
registry
-
under
(
merge
-
pathnames
".config/"
(
home
-
directory
))))
(
defun
system
-
source
-
registry
()
(
asdf
::
source
-
registry
-
under
(
system
-
directory
)))
(
defun
merge
-
temp
-
under
(
path
)
(
namestring
(
merge
-
pathnames
(
let
((
s
(
string
-
downcase
(
prin1
-
to
-
string
(
gentemp
)))))
(
concatenate
'string s "/"))
path
)))
(
defvar
*
asd
-
temp
-
path
-1
*
(
merge
-
temp
-
under
(
merge
-
temp
-
under
(
tmp
-
directory
))))
(
defvar
*
system
-
source
-
registry
-
config
*
`(:
source
-
registry
(:
inherit
-
configuration
)
(:
tree
,*
asd
-
temp
-
path
-
1
*)))
(
defvar
*
asd
-
temp
-
path
-2
*
(
namestring
(
tmp
-
directory
)))
(
defvar
*
home
-
source
-
registry
-
config
*
(
defvar
*
test
-
config
-1
*
`(:
source
-
registry
(:
inhert
-
configuration
)
(:
directory
,(
namestring
(
tmp
-
directory
)))))
(
defun
write
-
registry
-
file
(
path
contents
)
(
ensure
-
directories
-
exist
path
)
(
with
-
open
-
file
(
out
path
:
direction
:
output
:
if
-
exists
:
supersede
)
(
with
-
standard
-
io
-
syntax
(
format
out
"~S"
contents
))))
(
defun
write
-
system
-
source
-
registry
-
config
(&
key
(
path
(
system
-
source
-
registry
))
(
contents
*
system
-
source
-
registry
-
config
*))
(
write
-
registry
-
file
path
contents
))
(
defun
write
-
home
-
source
-
registry
-
config
(&
key
(
path
(
home
-
source
-
registry
))
(
contents
*
home
-
source
-
registry
-
config
*))
(
write
-
registry
-
file
path
contents
))
;; use *asd-temp-path-X*?
(
defun
create
-
asd
-
file
(&
optional
(
directory
*
default
-
pathname
-
defaults
*))
(
let
((*
default
-
pathname
-
defaults
*
directory
))
(
with
-
open
-
file
(
out
;; test environment variable
(
defun
test
-
environment
()
(
with
-
env
-
var
((
"CL_SOURCE_REGISTRY"
(
format
nil
"~A:~A"
(
home
-
directory
)
(
system
-
directory
))))
...))
;; test files
(
defun
test
-
files
()
...)
;; (cl-user::quit-on-error
;; ...)
\ No newline at end of file
(:
directory
,(
namestring
(
under
-
test
-
directory
"dir1/"
)))
(:
tree
,(
namestring
(
under
-
test
-
directory
"dir2/"
)))
(:
ignore
-
inherited
-
configuration
)))
(
defvar
*
test
-
expect
-1
*
(
loop
:
for
dir
:
in
'("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
:
collect
(
merge
-
pathnames
dir
*
test
-
directory
*)))
(
defvar
*
test
-
source
-
registries
*
'(
test
-
environment
-
source
-
registry
test
-
something
-2
test
-
something
-3))
(
cl
-
user
::
quit
-
on
-
error
(
assert
(
equal
(
process
-
source
-
registry
(
getenv
"CL_SOURCE_REGISTRY"
))
*
test
-
expect
-1*))
(
assert
(
equal
(
process
-
source
-
registry
*
test
-
config
-1*)
*
test
-
expect
-1*))
;; FIXME: add more tests
;; (assert (equal ...))
)
\ No newline at end of file
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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