Commit cfd78a31 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.161: fixes for SCL. Interactive testing on all lisps. Fix to a-d.asd

parent 77a4f446
......@@ -44,25 +44,16 @@ XCL ?= xcl
header_lisp := header.lisp
driver_lisp := package.lisp common-lisp.lisp utility.lisp os.lisp pathname.lisp filesystem.lisp stream.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp
all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
# Making ASDF itself should be our first, default, target:
build/asdf.lisp: $(wildcard *.lisp)
build/asdf.lisp: $(all_lisp)
mkdir -p build
cat $(header_lisp) $(driver_lisp) $(defsystem_lisp) > $@
cat $(all_lisp) > $@
# This quickly locates such mistakes as unbalanced parentheses:
load: load-in-sbcl
load-in-sbcl: build/asdf.lisp
rlwrap sbcl --eval '(setf *load-verbose* t *compile-verbose* t)' \
`for i in $(driver_lisp) $(defsystem_lisp) ; do echo --load $$i ; done` \
--eval '(in-package :asdf)'
load-in-cmucl: build/asdf.lisp
rlwrap cmucl -eval '(setf *load-verbose* t *compile-verbose* t *gc-verbose* nil)' \
`for i in $(driver_lisp) $(defsystem_lisp) ; do echo -load $$i ; done` \
-eval '(in-package :asdf)'
load: build/asdf.lisp
./test/run-tests.sh -t $l $(all_lisp)
install: archive-copy
......
......@@ -2,9 +2,9 @@
(in-package :asdf)
(defun call-without-redefinition-warnings (thunk)
(handler-bind ((or #+clozure ccl:compiler-warning
(handler-bind (((or #+clozure ccl:compiler-warning
#+cmu kernel:simple-style-warning)
#'muffle-warning)
#'muffle-warning))
(funcall thunk)))
(defsystem :asdf-driver
......
......@@ -62,7 +62,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.160" ;; to be automatically updated by make bump-version
:version "2.26.161" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.160: Another System Definition Facility.
;;; This is ASDF 2.26.161: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -194,11 +194,11 @@ then returning the non-empty string value of the variable"
;;; Current directory
#+(or cmu scl)
#+cmu
(defun* parse-unix-namestring* (unix-namestring)
(multiple-value-bind (host device directory name type version)
(lisp::parse-unix-namestring unix-namestring 0 (length unix-namestring))
(make-pathname :host (or host #+cmu lisp::*unix-host*) :device device
(make-pathname :host (or host lisp::*unix-host*) :device device
:directory directory :name name :type type :version version)))
(defun* getcwd ()
......@@ -208,7 +208,7 @@ then returning the non-empty string value of the variable"
#+allegro (excl::current-directory)
#+clisp (ext:default-directory)
#+clozure (ccl:current-directory)
#+(or cmu scl) (parse-unix-namestring*
#+(or cmu scl) (#+cmu parse-unix-namestring* #+scl lisp::parse-unix-namestring
(strcat (nth-value 1 (unix:unix-current-directory)) "/"))
#+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
#+ecl (ext:getcwd)
......
......@@ -180,10 +180,12 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
;; see also "valid physical pathname host" in the CLHS glossary, that suggests
;; strings and lists of strings or :unspecific
;; But CMUCL decides to die on NIL.
(make-pathname* :directory nil :name nil :type nil :version nil :device nil
:host (or #+cmu lisp::*unix-host*)
;; the default shouldn't matter, but we really want something physical
:defaults defaults))
#.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil
:host (or #+cmu lisp::*unix-host*)
#+scl ,@'(:scheme nil :scheme-specific-part nil
:username nil :password nil :parameters nil :query nil :fragment nil)
;; the default shouldn't matter, but we really want something physical
:defaults defaults))
(defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname))))
......
......@@ -19,11 +19,12 @@ usage () {
echo " -u -- upgrade tests."
echo " -c -- clean load test"
echo " -l -- load systems tests"
echo " -t -- test interactively"
}
unset DEBUG_ASDF_TEST upgrade clean_load load_systems
unset DEBUG_ASDF_TEST upgrade clean_load load_systems test_interactively
while getopts "cdhulhu" OPTION
while getopts "cdthulhu" OPTION
do
case $OPTION in
d)
......@@ -38,6 +39,9 @@ do
l)
load_systems=t
;;
t)
test_interactively=t
;;
h)
usage
exit 1
......@@ -367,9 +371,14 @@ test_load_systems () {
"(or #.(load \"test/script-support.lisp\") #.(asdf-test::with-test () (asdf-test::test-load-systems ${s})))" \
2>&1 | tee build/results/${lisp}-systems.text
}
test_interactively () {
rlwrap $cmd $eval "(or #.(load \"test/script-support.lisp\") #.(asdf-test::interactive-test '($*)))"
}
if [ -z "$cmd" ] ; then
echo "Error: cannot find or do not know how to run Lisp named $lisp"
elif [ -n "$test_interactively" ] ; then
test_interactively "$@"
elif [ -n "$clean_load" ] ; then
test_clean_load
elif [ -n "$load_systems" ] ; then
......
......@@ -304,6 +304,13 @@ is bound, write a message and exit on an error. If
(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
(funcall thunk)))
(defun interactive-test (&optional files)
(verbose t nil)
(loop :for file :in files :do
(load (string-downcase file)))
(setf *package* (some 'find-package '(:asdf :asdf/driver :asdf/utility :asdf/package :asdf-test)))
(load "contrib/debug.lisp"))
(defun load-asdf-lisp (&optional tag)
(quietly (load (asdf-lisp tag) :verbose *load-verbose* :print *load-print*)))
......
;;; -*- Lisp -*-
(in-package :asdf)
(use-package :asdf-test)
(progn
(assert
(every #'directory-pathname-p
(list
......@@ -41,20 +34,20 @@
(assert
(version-satisfies (asdf-version) (asdf-version)))
(assert
(version-satisfies (asdf-version) "2.000"))
(version-satisfies (asdf-version) "2.0"))
(assert
(not (version-satisfies (asdf-version) "666")))
(assert-equal
(mapcar 'namestring (split-native-pathnames-string "foo:bar"))
(assert-pathnames-equal
(split-native-pathnames-string "foo:bar")
'("foo" "bar"))
(assert-equal
(mapcar 'namestring (split-native-pathnames-string "foo:bar" :ensure-directory t))
(assert-pathnames-equal
(split-native-pathnames-string "foo:bar" :ensure-directory t)
'("foo/" "bar/"))
(assert-equal
(mapcar 'namestring (split-native-pathnames-string "/foo:/bar" :want-absolute t))
(assert-pathnames-equal
(split-native-pathnames-string "/foo:/bar" :want-absolute t)
'("/foo" "/bar"))
(assert-equal
(mapcar 'namestring (split-native-pathnames-string "/foo:/bar" :want-absolute t :ensure-directory t))
(assert-pathnames-equal
(split-native-pathnames-string "/foo:/bar" :want-absolute t :ensure-directory t)
'("/foo/" "/bar/"))
(assert-equal
(mapcar 'location-function-p
......@@ -66,4 +59,4 @@
(:function f too many arguments)
(:function (:lambda isnt lambda))
(:function (lambda (too many args) blah))))
'(t t nil nil nil nil)))
'(t t nil nil nil nil))
......@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.160")
(asdf-version "2.26.161")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (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