Commit 11a8348e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Merge branch 'run-program-sbcl-windows'

parents 7bd83836 7462a5ac
......@@ -7,8 +7,7 @@
(deftestcmd build-asdf-tools ()
"build a binary for asdf-tools"
(when (asdf:traverse :program-op :asdf-tools)
(asdf:operate :program-op :asdf-tools))
(asdf:operate :program-op :asdf-tools)
(success))
;;; Documentation
......
......@@ -48,10 +48,10 @@ The UNIX-y name will be downcased, and any % prefix will be dropped."
ext-init ext-clear ext-reset ext-update ;; extension
git-all-committed-p
bump-version bump ;; version
test-load-systems test-clean-load test-basic test-ascii %load install-asdf ;; test-basic
test-load-systems test-clean-load test-basic test-ascii %load install-asdf show-version ;; test-basic
test %t test-scripts ;; test-scripts
test-upgrade u extract-tagged-asdf extract-all-tagged-asdf extract ;; test-upgrade
test-all-clean-load test-all-scripts test-all-no-upgrade test-all-upgrade ;; test-all
test-all-basic test-all-clean-load test-all-scripts test-all-no-upgrade test-all-upgrade ;; test-all
test-all test-all-scripts-no-stop test-all-upgrade-no-stop
test-all-no-upgrade-no-stop test-all-no-stop
check-all-scripts-results check-all-upgrade-results check-all-results
......
......@@ -13,6 +13,19 @@
(defmacro with-all-lisps ((lisp-var lisps &key muffle-failures) &body body)
`(call-with-all-lisps (lambda (,lisp-var) ,@body) :lisps ,lisps :muffle-failures ,muffle-failures))
(deftestcmd test-all-basic (lisps systems)
"basic test: doc, clean-load, load-systems"
(without-stopping ()
(show-version)
(doc)
(test-ascii)
(test-all-clean-load lisps)
(test-all-load-systems lisps systems)))
(deftestcmd test-all-load-systems (lisps systems)
(with-systems-test (systems)
(with-all-lisps (l lisps) (test-load-systems l systems))))
(deftestcmd test-all-clean-load (lisps)
"test-clean-load on all lisps"
(with-all-lisps (l lisps) (test-clean-load l)))
......@@ -22,8 +35,8 @@
(with-all-lisps (l lisps) (test-scripts l)))
(deftestcmd test-all-no-upgrade ()
"test-basic, and test-all-script"
(test-basic) (test-all-scripts))
"test-all-basic, and test-all-script"
(test-all-basic) (test-all-scripts))
(deftestcmd test-all-upgrade (upgrade-lisps)
"test-upgrade on all lisps"
......@@ -44,16 +57,14 @@
(deftestcmd test-all-no-upgrade-no-stop ()
"all tests but upgrade on all lisps, no stop"
(without-stopping ()
(doc) (test-load-systems)
(test-all-clean-load)
(test-all-basic)
(test-all-scripts-no-stop)
(check-all-scripts-results)))
(deftestcmd test-all-no-stop () ;; TODO: pass arguments!
"all tests on all lisps, no stop"
(without-stopping ()
(doc) (test-load-systems)
(test-all-clean-load)
(test-all-basic)
(test-all-scripts-no-stop)
(test-all-upgrade-no-stop)
(check-all-results)))
......
......@@ -12,17 +12,30 @@ compilation errors and to interactively debug ASDF."
',(system-source-files :asdf/defsystem :monolithic t)))
:lisp lisp :debugger t :output :interactive)))
(defmacro with-systems-test ((systems) &body body)
`(call-with-systems-test ,systems (lambda () ,@body)))
(defun call-with-systems-test (systems thunk)
(if systems
(funcall thunk)
(format t "Skipping system loading test.
To enable the system loading test,
export ASDF_TEST_SYSTEMS=\"some systems\"
or pass s=\"some systems\" to your make command
and this test with make sure those systems can be loaded.~%")))
(deftestcmd test-load-systems (lisp systems)
"test loading of your favorite systems
Use your preferred Lisp implementation"
(with-asdf-dir ()
(let* ((log (newlogfile "systems" lisp)))
(log! log "Loading all these systems on ~(~A~):~{~% ~A~}~%~%" lisp systems)
(run-test-lisp
"loading the systems"
`((load "test/script-support.lisp")
(asdf-test::with-test () (asdf-test::test-load-systems ,@systems)))
:lisp lisp :log log))))
(with-systems-test (systems)
(with-asdf-dir ()
(let* ((log (newlogfile "systems" lisp)))
(log! log "Loading all these systems on ~(~A~):~{~% ~A~}~%~%" lisp systems)
(run-test-lisp
"loading the systems"
`((load "test/script-support.lisp")
(asdf-test::with-test () (asdf-test::test-load-systems ,@systems)))
:lisp lisp :log log)))))
(deftestcmd test-clean-load (lisp log)
"test that asdf load cleanly
......@@ -57,6 +70,7 @@ Use your preferred lisp implementation and check that asdf is loaded without any
(deftestcmd test-basic (lisp systems)
"basic test: doc, clean-load, load-systems"
(without-stopping ()
(show-version)
(doc)
(test-ascii)
(test-clean-load lisp)
......@@ -67,3 +81,7 @@ Use your preferred lisp implementation and check that asdf is loaded without any
(success-if
(loop for c across (read-file-string (pn "build/asdf.lisp"))
always (<= 0 (char-code c) 127))))
(deftestcmd show-version ()
(format t "Building and testing asdf ~A~%" (version-from-tag)))
......@@ -136,7 +136,7 @@ and which systems to test loading with ASDF_TEST_SYSTEMS or s=
(upgrade-methods ((upgrade-methods *upgrade-test-methods*))
(setf upgrade-methods (get-upgrade-methods upgrade-methods)))
(new-version (new-version)
(setf new-version (or new-version (next-version (version-from-file))))))
(setf new-version (or new-version (compute-next-version (version-from-file))))))
:for arg :in args
:for (found larg init) = (assoc arg argmap)
:append (if found larg (list arg)) :into largs
......@@ -157,7 +157,7 @@ and which systems to test loading with ASDF_TEST_SYSTEMS or s=
(apply ',real args)))
(deftestcmd interactive-command (lisp)
(let* ((command (lisp-invocation-arglist :implementation-type lisp :debugger t)))
(let* ((command (lisp-invocation-arglist :implementation-type lisp :debugger t :console t)))
(return-from interactive-command (cons "rlwrap" command))))
(defparameter *default-test-lisps*
......@@ -222,7 +222,7 @@ and which systems to test loading with ASDF_TEST_SYSTEMS or s=
(format t "~&Now ~A...~@[ (log in ~A)~]~%" activity log)
(let* ((eval (compose-non-special-string forms)) ;; at least avoiding ~% is necessary on Windows.
(command (lisp-invocation-arglist :implementation-type (get-lisp lisp)
:eval eval :debugger debugger))
:eval eval :debugger debugger :console t))
(interactive (if (eq output :interactive) :interactive nil))
(output (if (eq output t) *standard-output* output))
(output (if (eq output *stdout*) :interactive output)))
......
......@@ -85,6 +85,6 @@ Ran ~D tests, ~D passed, ~D failed~
(deftestcmd test (lisp test-scripts)
"run all normal tests but upgrade tests
Use the preferred lisp implementation"
(without-stopping () (doc) (test-clean-load lisp) (test-scripts lisp test-scripts)))
(without-stopping () (test-basic lisp) (test-scripts lisp test-scripts)))
(defalias %t test)
......@@ -5,19 +5,23 @@
(defparameter *default-upgrade-test-tags*
;; We return a list of entries in reverse chronological order,
;; which should also be more or less the order of decreasing relevance.
;; By default, we only test the last of each relevant series.
'("REQUIRE" "3.2.0" "3.1.7" "3.0.3" "2.26"))
(defparameter *all-upgrade-test-tags*
'("REQUIRE" ;; a magic tag meaning whatever your implementation provides, if anything
"3.1.7" ;; (2016-03-23) more bug fixes, latest release (as of 2016-09-17)
"3.1.5" ;; (2015-07-21) more bug fixes
"3.0.3" ;; (2013-10-22) the last in the ASDF 3.0 series
"2.26")) ;; (2012-10-30), last in ASDF 2 series, still sported by Quicklisp 2016-02-22 (!)
(defparameter *obsolete-upgrade-test-tags*
'(;; The 3.1 series provides the asdf3.1 feature, meaning users can rely on
;; The 3.2 series provides the asdf3.2 feature, meaning users can rely on
;; all its new features (launch-program, improved bundle support), as well as
;; the improvements done in 3.1 (e.g. XDG support).
"3.2.0" ;; (2017-01-08) first (and latest) in 3.2 series
;; The 3.1 series provides the asdf3.1 feature, meaning users can rely on
;; all the stabilization work done in 3.0 so far, plus extra developments
;; in UIOP, package-inferred-system, and more robustification.
;;(included above) "3.1.7" ;; (2016-03-23) more bug fixes, latest release (as of 2016-09-17)
"3.1.7" ;; (2016-03-23) more bug fixes, last in 3.1 series
"3.1.6" ;; (2015-10-17) more bug fixes
;;(included above) "3.1.5" ;; (2015-07-21) more bug fixes, what SBCL sports (as of 1.3.9, 2016-08-30)
"3.1.5" ;; (2015-07-21) more bug fixes, what SBCL sports (as of 1.3.14, 2017-02-04)
"3.1.4" ;; (2014-10-09) more bug fixes, source-registry cache, in LispWorks 7
"3.1.3" ;; (2014-07-24) a bug fix release for 3.1.2
"3.1.2" ;; (2014-05-06) the first ASDF 3.1 release
......@@ -26,7 +30,7 @@
;; with Robert Goldman taking over maintainership at 3.0.2.
;; 3.0.0 was just 2.33.10 promoted, but version-satisfies meant it was suddenly
;; not compatible with ASDF2 anymore, so we immediately released 3.0.1
;;(included above) "3.0.3" ;; (2013-10-22) the last in the ASDF 3.0 series
"3.0.3" ;; (2013-10-22) last in the ASDF 3.0 series
"3.0.2" ;; (2013-07-02) the first ASDF 3 in SBCL
"3.0.1" ;; (2013-05-16) the first stable ASDF 3 release
......@@ -37,7 +41,7 @@
;; The ASDF 2 series
;; Note that 2.26.x is where the refactoring that begat ASDF 3 took place.
;; 2.26.61 is the last single-file, single-package ASDF.
;;(included above) "2.26" ;; (2012-10-30), last in ASDF 2 series, still sported by Quicklisp 2016-02-22 (!), long used by SBCL, etc.
"2.26" ;; (2012-10-30), last in ASDF 2 series, still sported by Quicklisp 2016-02-22 (!), long used by SBCL, etc.
"2.22" ;; (2012-06-12) used by debian wheezy, etc.
"2.20" ;; (2012-01-18) in CCL 1.8, Ubuntu 12.04 LTS
"2.019" ;; (2011-11-29) still included in LispWorks in 2014.
......@@ -59,9 +63,10 @@
((string-equal x :default)
*default-upgrade-test-tags*)
((string-equal x :old)
*obsolete-upgrade-test-tags*)
(remove-if (lambda (x) (member x *default-upgrade-test-tags* :test 'equal))
*all-upgrade-test-tags*))
((string-equal x :all)
(append *default-upgrade-test-tags* *obsolete-upgrade-test-tags*))
*all-upgrade-test-tags*)
(t (ensure-list-of-strings (string x)))))))
(defun extract-tagged-asdf (tag)
......@@ -107,12 +112,21 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
(or
(string-equal tag "REQUIRE") ;; we are hopefully always able to upgrade from REQUIRE
(ecase lisp
;; ABCL makes it damn slow. Also, for some reason, we punt on anything earlier than 2.25,
;; and only need to test it once, below for 2.24.
((:abcl) (version<= "2.24" tag))
;; ABCL works but is super-slow. Since we now punt on all of 2.x,
;; no need to check anything below 2.26.
((:abcl) (version<= "2.26" tag))
;; CCL fasl numbering broke loading of old asdf 2.0
((:ccl) (or (version< tag "2.0") (version<= "2.20" tag)))
;; Allegro ships with versions 3*, so give up testing 2
;; Also, unpatched Allegro 10 has bug updating from 2.26 and before
((:allegro :allegromodern :allegro8 :allegromodern8
:allegro_64 :allegromodern_64 :allegro8_64 :allegromodern8_64
:allegro_s :allegromodern_s :allegro8_s :allegromodern8_s
:allegro_64_s :allegromodern_64_s :allegro8_64_s :allegromodern8_64_s)
(version<= "2.27" tag))
;; CCL fasl numbering broke loading of old asdf 2.0, and the punting for 2.26 fails,
;; but who cares since CCL has always been shipping recent versions of ASDF.
((:ccl) (version<= "2.27" tag))
;; CLASP is only supported as of 3.1.4.3
((:clasp) (version<= "3.1.4.3" tag))
......@@ -144,18 +158,14 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
;; MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip.
((:mkcl) (version<= "3.1.2" tag))
;; all clear on these implementations
((:sbcl :scl) t)
;; XCL support starts with ASDF 2.014.2
;; — It also dies during upgrade trying to show the backtrace.
;; We recommend you replace XCL's asdf using:
;; ./tools/asdf-tools install-asdf xcl
((:xcl) (version<= "2.15" tag))
;; all clear on these implementations
((:allegro :allegromodern :allegro8 :allegromodern8
:allegro_64 :allegromodern_64 :allegro8_64 :allegromodern8_64
:allegro_s :allegromodern_s :allegro8_s :allegromodern8_s
:allegro_64_s :allegromodern_64_s :allegro8_64_s :allegromodern8_64_s
:sbcl :scl) t))))
((:xcl) (version<= "2.15" tag)))))
(deftestcmd test-upgrade (lisp upgrade-tags upgrade-methods)
"run upgrade tests
......
......@@ -2,7 +2,7 @@
;;; Extracting version information
(defparameter *version-tag-glob* "[0-9][.][0-9]*")
(defparameter *version-tag-glob* "[0-9][.][0-9]*") ;; NB: it's a glob, not regex
(defun version-from-tag (&optional commit)
;; run-program issue: :output :line closes the fd, which causes the program to die in error.
......@@ -51,7 +51,7 @@
(defparameter *old-version* :default)
(defparameter *new-version* :default)
(defun next-version (v)
(defun compute-next-version (v)
(let ((pv (parse-version v 'error)))
(assert (first pv))
(assert (second pv))
......@@ -70,7 +70,7 @@
(v1 (check (version-from-file) v1))
((not (eq *new-version* :default)) *new-version*) ;; Ugly passing of argument from Makefile.
(t (let ((old (version-from-file)))
(check old (next-version old)))))))
(check old (compute-next-version old)))))))
(deftype byte-vector () '(array (unsigned-byte 8) (*)))
......@@ -144,3 +144,4 @@
(git `(commit -a -m ("Bump version to ",v)))
(git `(tag ,v))
v))
......@@ -445,17 +445,27 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(shell-boolean-exit
(restore-image))))))))
(when forms `(progn ,@forms))))))
#+(or clasp ecl) (check-type kind (member :dll :lib :static-library :program :object :fasl))
#+(or clasp ecl mkcl)
(check-type kind (member :dll :shared-library :lib :static-library
:fasl :fasb :program))
(apply #+clasp 'cmp:builder #+clasp kind
#+ecl 'c::builder #+ecl kind
#+mkcl (ecase kind
((:dll) 'compiler::build-shared-library)
((:lib :static-library) 'compiler::build-static-library)
((:fasl) 'compiler::build-bundle)
((:program) 'compiler::build-program))
#+(or ecl mkcl)
(ecase kind
((:dll :shared-library)
#+ecl 'c::build-shared-library #+mkcl 'compiler:build-shared-library)
((:lib :static-library)
#+ecl 'c::build-static-library #+mkcl 'compiler:build-static-library)
((:fasl #+ecl :fasb)
#+ecl 'c::build-fasl #+mkcl 'compiler:build-fasl)
#+mkcl ((:fasb) 'compiler:build-bundle)
((:program)
#+ecl 'c::build-program #+mkcl 'compiler:build-program))
(pathname destination)
#+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files (append lisp-object-files #+(or clasp ecl) extra-object-files)
#+(or clasp ecl) :init-name #+(or clasp ecl) (c::compute-init-name (or output-name destination) :kind kind)
#+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files
(append lisp-object-files #+(or clasp ecl) extra-object-files)
#+ecl :init-name
#+ecl (c::compute-init-name (or output-name destination)
:kind (if (eq kind :fasb) :fasl kind))
(append
(when prologue-code `(:prologue-code ,prologue-code))
(when epilogue-code `(:epilogue-code ,epilogue-code))
......
......@@ -506,6 +506,9 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(%handle-if-does-not-exist input if-input-does-not-exist)
(%handle-if-exists output if-output-exists)
(%handle-if-exists error-output if-error-output-exists))
#+ecl (let ((*standard-input* *stdin*)
(*standard-output* *stdout*)
(*error-output* *stderr*)))
(let ((process-info (make-instance 'process-info))
(input (%normalize-io-specifier input :input))
(output (%normalize-io-specifier output :output))
......@@ -517,6 +520,14 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#+os-unix (list command)
#+os-windows
(string
;; NB: On other Windows implementations, this is utterly bogus
;; except in the most trivial cases where no quoting is needed.
;; Use at your own risk.
#-(or allegro clisp clozure ecl)
(nest
#+(or ecl sbcl) (unless (find-symbol* :escape-arguments #+ecl :ext #+sbcl :sb-impl nil))
(parameter-error "~S doesn't support string commands on Windows on this Lisp"
'launch-program command))
;; NB: We add cmd /c here. Behavior without going through cmd is not well specified
;; when the command contains spaces or special characters:
;; IIUC, the system will use space as a separator,
......@@ -527,14 +538,9 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
;; On ClozureCL for Windows, we assume you are using
;; r15398 or later in 1.9 or later,
;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858
;; On ECL, commit 2040629 https://gitlab.com/embeddable-common-lisp/ecl/issues/304
;; On SBCL, we assume the patch from fcae0fd (to be part of SBCL 1.3.13)
#+(or clozure sbcl) (cons "cmd" (strcat "/c " command))
;; NB: On other Windows implementations, this is utterly bogus
;; except in the most trivial cases where no quoting is needed.
;; Use at your own risk.
#-(or allegro clisp clozure sbcl)
(parameter-error "~S doesn't support string commands on Windows on this lisp: ~S"
'launch-program command))
#+(or clozure ecl sbcl) (cons "cmd" (strcat "/c " command)))
#+os-windows
(list
#+allegro (escape-windows-command command)
......@@ -542,7 +548,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#+(or abcl (and allegro os-unix) clozure cmucl ecl mkcl sbcl)
(let ((program (car command))
#-allegro (arguments (cdr command))))
#+(and sbcl os-windows)
#+(and (or ecl sbcl) os-windows)
(multiple-value-bind (arguments escape-arguments)
(if (listp arguments)
(values arguments t)
......@@ -565,7 +571,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#+mkcl 'mk-ext:run-program
#+sbcl 'sb-ext:run-program
#+(or abcl clozure cmucl ecl mkcl sbcl) ,@'(program arguments)
#+(and sbcl os-windows) ,@'(:escape-arguments escape-arguments)
#+(and (or ecl sbcl) os-windows) ,@'(:escape-arguments escape-arguments)
:input input :if-input-does-not-exist :error
:output output :if-output-exists :append
,(or #+(or allegro lispworks) :error-output :error) error-output
......
......@@ -223,7 +223,8 @@ then returning the non-empty string value of the variable"
(ecase ext:*case-mode* (:upper "") (:lower "l")))
#+ecl (format nil "~A~@[-~A~]" s
(let ((vcs-id (ext:lisp-implementation-vcs-id)))
(subseq vcs-id 0 (min (length vcs-id) 8))))
(unless (equal vcs-id "UNKNOWN")
(subseq vcs-id 0 (min (length vcs-id) 8)))))
#+gcl (subseq s (1+ (position #\space s)))
#+genera
(multiple-value-bind (major minor) (sct:get-system-version "System")
......
......@@ -46,9 +46,10 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; This public variable will be bound shortly to the currently loaded version of ASDF.
(defvar *asdf-version* nil)
;; We need to clear systems from versions older than the one in this (private) parameter.
;; The latest incompatible defclass is 2.32.13 renaming a slot in component;
;; The latest incompatible defclass is 2.32.13 renaming a slot in component,
;; or 3.2.0.2 for CCL (incompatibly changing some superclasses).
;; the latest incompatible gf change is in 3.1.7.20 (see redefined-functions below).
(defparameter *oldest-forward-compatible-asdf-version* "3.1.7.20")
(defparameter *oldest-forward-compatible-asdf-version* "3.2.0.2")
;; Semi-private variable: a designator for a stream on which to output ASDF progress messages
(defvar *verbose-out* nil)
;; Private function by which ASDF outputs progress messages and warning messages:
......@@ -122,7 +123,15 @@ previously-loaded version of ASDF."
(redefined-classes
;; redefining the classes causes interim circularities
;; with the old ASDF during upgrade, and many implementations bork
'((#:compile-concatenated-source-op (#:operation) ()))))
#-clozure ()
#+clozure
'((#:compile-concatenated-source-op (#:operation) ())
(#:compile-bundle-op (#:operation) ())
(#:concatenate-source-op (#:operation) ())
(#:dll-op (#:operation) ())
(#:lib-op (#:operation) ())
(#:monolithic-compile-bundle-op (#:operation) ())
(#:monolithic-concatenate-source-op (#:operation) ()))))
(loop :for name :in redefined-functions
:for sym = (find-symbol* name :asdf nil)
:do (when sym (fmakunbound sym)))
......
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