From cfd78a311b0044974351acfff63dc0bd627171e4 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Mon, 28 Jan 2013 15:42:15 -0500 Subject: [PATCH] 2.26.161: fixes for SCL. Interactive testing on all lisps. Fix to a-d.asd --- Makefile | 19 +++++-------------- asdf-driver.asd | 4 ++-- asdf.asd | 2 +- header.lisp | 2 +- os.lisp | 6 +++--- pathname.lisp | 10 ++++++---- test/run-tests.sh | 13 +++++++++++-- test/script-support.lisp | 7 +++++++ test/test-utilities.script | 27 ++++++++++----------------- upgrade.lisp | 2 +- version.lisp-expr | 2 +- 11 files changed, 48 insertions(+), 46 deletions(-) diff --git a/Makefile b/Makefile index e00afdf5c..f4554f2ca 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/asdf-driver.asd b/asdf-driver.asd index 93ea577a2..6a393912d 100644 --- a/asdf-driver.asd +++ b/asdf-driver.asd @@ -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 diff --git a/asdf.asd b/asdf.asd index 755252d8e..00bb62535 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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. diff --git a/header.lisp b/header.lisp index 495ab43f8..24854d236 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- 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>. diff --git a/os.lisp b/os.lisp index c800baaa9..68423a8a1 100644 --- a/os.lisp +++ b/os.lisp @@ -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) diff --git a/pathname.lisp b/pathname.lisp index 30c64c607..7037d4a41 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -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)))) diff --git a/test/run-tests.sh b/test/run-tests.sh index 2952e732f..a7d226855 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -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 diff --git a/test/script-support.lisp b/test/script-support.lisp index 849e142f6..eb4325228 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -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*))) diff --git a/test/test-utilities.script b/test/test-utilities.script index 435540c03..a16efe0e8 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -1,12 +1,5 @@ ;;; -*- 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)) diff --git a/upgrade.lisp b/upgrade.lisp index f347e0cff..898466658 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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)) diff --git a/version.lisp-expr b/version.lisp-expr index 22c1efebd..16d8e942e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.160" +"2.26.161" -- GitLab