Commit cb1043ac authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Merge branch 'master' into docs

parents 6eb7d1b7 cc8a15eb
......@@ -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/
......
......@@ -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,
......
......@@ -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.111" ;; to be automatically updated by make bump-version
:version "3.1.0.113" ;; 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)
......
......@@ -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)
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.0.111: Another System Definition Facility.
;;; This is ASDF 3.1.0.113: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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/")
......
......@@ -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")
......@@ -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~%~
......
......@@ -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.111")
(asdf-version "3.1.0.113")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
......
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