Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
cb1043ac
Commit
cb1043ac
authored
Apr 15, 2014
by
Robert P. Goldman
Browse files
Merge branch 'master' into docs
parents
6eb7d1b7
cc8a15eb
Changes
13
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
cb1043ac
...
...
@@ -17,6 +17,7 @@ doc/asdf.pg
doc/asdf.toc
doc/asdf.tps
doc/asdf.tp
doc/asdf.tps
doc/asdf.vr
doc/asdf.vrs
doc/asdf.t2d/
...
...
TODO
View file @
cb1043ac
...
...
@@ -189,7 +189,9 @@
*** have a function verify-strict-asd that can verify a asd is pure lp#541562
Then if it passes, use load-strict-asd.
If not, optionally issue a warning. Start migrating people toward that.
*** Include tests for prebuilt-system in test-bundle and in test-program.
** Include tests for prebuilt-system in test-bundle and in test-program.
** Test that a package-system secondary system is properly superseded
when the primary system is redefined.
* Learn to use cl-grid-test
** So we can easily make sure ASDF changes don't break stuff,
...
...
asdf.asd
View file @
cb1043ac
...
...
@@ -75,7 +75,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"3.1.0.11
1
"
;; to be automatically updated by make bump-version
:version
"3.1.0.11
3
"
;; to be automatically updated by make bump-version
:depends-on
()
#+
asdf3
:encoding
#+
asdf3
:utf-8
:class
#.
(
if
(
find-class
'package-system
nil
)
'package-system
'system
)
...
...
component.lisp
View file @
cb1043ac
...
...
@@ -272,11 +272,16 @@ children.")))
;;;; version-satisfies
(
with-upgradability
()
;; short-circuit testing of null version specifications.
;; this is an all-pass
(
defmethod
version-satisfies
:around
((
c
t
)
(
version
null
))
(
declare
(
ignorable
c
version
))
t
)
(
defmethod
version-satisfies
((
c
component
)
version
)
(
unless
(
and
version
(
slot-boundp
c
'version
)
(
component-version
c
))
(
when
version
(
warn
"Requested version ~S but ~S has no version"
version
c
))
(
return-from
version-satisfies
t
))
(
return-from
version-satisfies
nil
))
(
version-satisfies
(
component-version
c
)
version
))
(
defmethod
version-satisfies
((
cver
string
)
version
)
...
...
header.lisp
View file @
cb1043ac
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.0.11
1
: Another System Definition Facility.
;;; This is ASDF 3.1.0.11
3
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
test/make-hello-world.lisp
View file @
cb1043ac
...
...
@@ -10,6 +10,11 @@
(
asdf-test::frob-packages
)
(
println
"This is make-hello-world, testing its standard-output."
)
; *standard-output*
(
println
"This is make-hello-world, testing its error-output."
*error-output*
)
(
println
"This is make-hello-world, testing its stdout."
*stdout*
)
(
println
"This is make-hello-world, testing its stderr."
*stderr*
)
#+
mkcl
(
defun
add-mkcl-dll
(
pathname
)
;; make sure mkcl-X.X.X.dll is the same directory as the executable
...
...
test/run-tests.sh
View file @
cb1043ac
...
...
@@ -218,6 +218,8 @@ case "$lisp" in
allegromodern_64_s
)
command
=
"
${
ALLEGROMODERN_64_S
:-
mlisp_64_s
}
"
;;
allegromodern8_64_s
)
command
=
"
${
ALLEGROMODERN8_64_S
:-
mlisp8_64_s
}
"
;;
esac
# For the sake of the lisp-invocation library, re-export these
ALLEGRO
=
$command
;
export
ALLEGRO
flags
=
"-q"
nodebug
=
"-batch"
if
[
"
$os
"
=
windows
]
&&
[
-z
"
$ALLEGRO_NOISY
"
]
;
then
bcmd
=
"
$command
+c
$flags
"
;
fi
...
...
test/test-program.script
View file @
cb1043ac
...
...
@@ -23,91 +23,101 @@
;; try harder by enabling the user's source-registry
(initialize-source-registry ""))
(unless (find-system :lisp-invocation nil)
(leave-test "Couldn't find lisp-invocation. Skipping the rest the test." 0))
(leave-test "Couldn't find lisp-invocation. Skipping the rest
of
the test." 0))
(load-system :lisp-invocation)
(unless (version-satisfies (find-system :lisp-invocation) "1")
(leave-test "Lisp-invocation library isn't new enough to test successfully. Skipping test-program." 0))
;; Disable any user source registry.
(initialize-source-registry `(:source-registry :ignore-inherited-configuration))
(DBG "test image-op")
(defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p img))
(delete-file-if-exists img)
(DBG "- first create an executable image")
(assert-equal
(nth-value 2
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
:eval "(asdf-test::make-hello-image)")
:output t :error-output :output :input nil))
0)
(assert (probe-file* img) () "Can't find image file ~S" img)
(defun make-hello-world (kind)
(assert-equal
0
(nth-value 2
(run-program
(symbol-call
:lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:cross-compile nil
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
:eval (format nil "(asdf-test::make-hello-~a)" kind))
:input nil :ignore-error-status t
:output (list *standard-output* :linewise t :prefix "stdout: ")
:error-output (list *error-output* :linewise t :prefix "stderr: ")))))
(DBG "- then, use it")
(assert-equal
(nest
#+lispworks (last)
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)")
:output :lines :error-output t))
'("hello, world"))
#-(or (and lispworks os-macosx)
(and ecl os-macosx))
(progn
(DBG "test image-op")
(defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p img))
(delete-file-if-exists img)
(DBG "- first create an executable image")
(make-hello-world 'image)
(assert (probe-file* img) () "Can't find image file ~S" img)
(DBG "- now, use it with arguments")
#-(or lispworks scl) ;; These can't be passed arguments the normal way
(assert-equal
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)"
:arguments '("a" "b c" "d"))
:output :lines :error-output t)
'("hello, world"
"You passed 3 arguments:"
" \"a\""
" \"b c\""
" \"d\""))
(DBG "- then, use it")
(assert-equal
(nest
#+lispworks (last)
(run-program
(symbol-call
:lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:cross-compile nil
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)")
:output :lines :error-output t))
'("hello, world"))
(DBG "test program-op")
(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
"2.48"))
(DBG "Creating standalone programs is not supported on your CL implementation")
(leave-test "Skipping test" 0))
(DBG "- now, use it with arguments")
#-(or lispworks scl) ;; These can't be passed arguments the normal way
(assert-equal
(run-program
(symbol-call
:lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:image-path (native-namestring img)
:cross-compile nil
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)"
:arguments '("a" "b c" "d"))
:output :lines :error-output t)
'("hello, world"
"You passed 3 arguments:"
" \"a\""
" \"b c\""
" \"d\"")))
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
(delete-file-if-exists exe)
(DBG "- first, create the standalone program")
(assert-equal
(nth-value 2
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
:eval "(asdf-test::make-hello-program)")
:output t :error-output :output :input nil))
0)
#-(or (and lispworks os-macosx)
(and ecl os-macosx))
(progn
(DBG "test program-op")
(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
"2.48"))
(DBG "Creating standalone programs is not supported on your CL implementation")
(leave-test "Skipping test" 0))
(assert (probe-file* exe) () "Can't find executable file ~S" exe)
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
(delete-file-if-exists exe)
(DBG "- first, create the standalone program")
(make-hello-world 'program)
(assert (probe-file* exe) () "Can't find executable file ~S" exe)
(DBG "- use that")
(assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t)
'("hello, world"))
(DBG "- use that")
(assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t)
'("hello, world"))
(DBG "- use that with arguments")
(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines :error-output t)
'("hello, world"
"You passed 3 arguments:"
" \"a\""
" \"b c\""
" \"d\""))
(DBG "- use that with arguments")
(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines :error-output t)
'("hello, world"
"You passed 3 arguments:"
" \"a\""
" \"b c\""
" \"d\""))
)
#+(or ecl mkcl)
(progn
...
...
test/test-utilities.script
View file @
cb1043ac
...
...
@@ -30,7 +30,7 @@
(assert (version-satisfies (asdf-version) (asdf-version)))
(assert (version-satisfies (asdf-version) "3.0"))
(assert (version-satisfies (asdf-version) "2.0"))
(assert (version-satisfies (find-system :test-asdf) "666"))
(assert
(not
(version-satisfies (find-system :test-asdf) "666"))
)
(handler-case (version-satisfies (find-system :test-asdf) "666")
(simple-warning (c)
(assert (search "Requested version ~S but ~S has no version" (simple-condition-format-control c))))
...
...
@@ -39,19 +39,24 @@
(error "version-satisfies must warn when given component without version")))
(assert (version<= "2.0" (asdf-version)))
(assert (not (version-satisfies (asdf-version) "666")))
(DBG "First pathname test.")
(assert-pathnames-equal
(split-native-pathnames-string (join-namestrings '("foo" "bar")))
'(#p"foo" #p"bar"))
(DBG "Second pathname test.")
(assert-pathnames-equal
(split-native-pathnames-string (join-namestrings '("foo" "bar")) :ensure-directory t)
'(#p"foo/" #p"bar/"))
(DBG "Third pathname test.")
(assert-pathnames-equal
(split-native-pathnames-string (join-namestrings '("/foo" "/bar")) :want-absolute t)
'(#p"/foo" #p"/bar"))
(DBG "Fourth pathname test.")
(assert-pathnames-equal
(split-native-pathnames-string (join-namestrings '("/foo" "/bar"))
:want-absolute t :ensure-directory t)
'(#p"/foo/" #p"/bar/"))
(DBG "Fifth pathname test.")
(assert-equal
(mapcar 'location-function-p
'((:function f)
...
...
@@ -213,8 +218,8 @@
(assert-pathnames-equal
(sort directory-b #'string< :key #'(lambda (x) (car (last (pathname-directory x)))))
(list (subpathname *build-directory* "deleteme/a/b/c/")
(subpathname *build-directory* "deleteme/a/b/d/")
(subpathname *build-directory* "deleteme/a/b/e/"))))
(subpathname *build-directory* "deleteme/a/b/d/")
(subpathname *build-directory* "deleteme/a/b/e/"))))
(delete-empty-directory (subpathname *build-directory* "deleteme/a/b/e/"))
(assert (not (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/"))))
(delete-directory-tree (subpathname *build-directory* "deleteme/")
...
...
test/test-version.script
View file @
cb1043ac
...
...
@@ -13,6 +13,9 @@
(DBG "Check that the fallback system bears the current asdf version")
(assert-equal (asdf-version) (component-version *asdf*))
(def-test-system :unversioned-system
:pathname #.*test-directory*)
(def-test-system :versioned-system-1
:pathname #.*test-directory*
:version "1.0")
...
...
@@ -39,8 +42,19 @@
(defun vtest (name v &optional (true t))
(or (eq true (version-satisfies (find-system name) v))
(error "no satisfaction: ~S version ~A not ~A" name v true)))
(vtest :versioned-system-1 "1.0")
(vtest :versioned-system-2 "1.0")
(vtest :versioned-system-3 "2.0" nil)
(vtest :versioned-system-file-form "1.0")
(vtest :versioned-system-file-line "1.0")
;; version UNmatching
(vtest :unversioned-system "1" nil)
(vtest :versioned-system-1 "1.1" nil)
(vtest :versioned-system-2 "1.1" t)
(vtest :versioned-system-2 "1.1.1" nil)
(vtest :versioned-system-2 "1.2" nil)
(vtest :versioned-system-3 "1.2")
(vtest :versioned-system-3 "1.1")
(vtest :versioned-system-3 "1.1.1")
uiop/os.lisp
View file @
cb1043ac
...
...
@@ -63,10 +63,11 @@ keywords explicitly."
"Detects the current operating system. Only needs be run at compile-time,
except on ABCL where it might change between FASL compilation and runtime."
(
loop*
:with
o
:for
(
feature
.
detect
)
:in
'
((
:os-unix
.
os-unix-p
)
(
:os-
windows
.
os-windows
-p
)
(
:os-
macosx
.
os-macosx
-p
)
:for
(
feature
.
detect
)
:in
'
((
:os-unix
.
os-unix-p
)
(
:os-
macosx
.
os-macosx
-p
)
(
:os-
windows
.
os-windows
-p
)
(
:genera
.
os-genera-p
)
(
:os-oldmac
.
os-oldmac-p
))
:when
(
and
(
not
o
)
(
funcall
detect
))
:do
(
setf
o
feature
)
(
pushnew
o
*features*
)
:when
(
and
(
or
(
not
o
)
(
eq
feature
:os-macosx
))
(
funcall
detect
))
:do
(
setf
o
feature
)
(
pushnew
feature
*features*
)
:else
:do
(
setf
*features*
(
remove
feature
*features*
))
:finally
(
return
(
or
o
(
error
"Congratulations for trying ASDF on an operating system~%~
...
...
upgrade.lisp
View file @
cb1043ac
...
...
@@ -67,7 +67,7 @@ previously-loaded version of ASDF."
;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(
asdf-version
"3.1.0.11
1
"
)
(
asdf-version
"3.1.0.11
3
"
)
(
existing-version
(
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
...
...
version.lisp-expr
View file @
cb1043ac
"3.1.0.11
1
"
"3.1.0.11
3
"
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