Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
A
asdf
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Hugo Ishimaru
asdf
Commits
08149c40
Commit
08149c40
authored
15 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Plain Diff
Merge branch 'master' of
ssh://frideau@common-lisp.net/project/xcvb/git/asdf
parents
31c47c52
7c184ec6
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
.gitignore
+1
-0
1 addition, 0 deletions
.gitignore
test/run-tests.sh
+11
-1
11 additions, 1 deletion
test/run-tests.sh
test/test-source-registry.s
+39
-112
39 additions, 112 deletions
test/test-source-registry.s
with
51 additions
and
113 deletions
.gitignore
+
1
−
0
View file @
08149c40
...
...
@@ -7,6 +7,7 @@ website/changelog.xml
# Test stuff
test/results/
test/tmp/
# We build these at various stages in the make process
LICENSE
...
...
This diff is collapsed.
Click to expand it.
test/run-tests.sh
+
11
−
1
View file @
08149c40
...
...
@@ -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
"
...
...
This diff is collapsed.
Click to expand it.
test/test-source-registry.s
+
39
−
112
View file @
08149c40
...
...
@@ -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
-
regist
ry
(
:
use
#
:
cl
#
:
asdf
))
(
def
var
*
test
-
directo
ry
*
(
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
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment