Commit 0af76dd1 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.99: portability fixes for ABCL and CLISP.

parent 3a73624e
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.98" ;; to be automatically updated by bin/bump-revision :version "2.26.99" ;; to be automatically updated by bin/bump-revision
:depends-on () :depends-on ()
:components ((:module "build" :components ((:file "asdf")))) :components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf)))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf))))
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.98: Another System Definition Facility. ;;; This is ASDF 2.26.99: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -299,16 +299,16 @@ or when loading the package is optional." ...@@ -299,16 +299,16 @@ or when loading the package is optional."
(setf *package-fishiness* nil))) (setf *package-fishiness* nil)))
(defun record-fishy (info) (defun record-fishy (info)
(push info *package-fishiness*)) (push info *package-fishiness*))
(macrolet ((when-fishy (&body body) (defun ensure-package (name &key
`(when *all-package-fishiness* ,@body)) nicknames documentation use
(fishy (&rest info) shadow shadowing-import-from
`(when-fishy (record-fishy (list ,@info))))) import-from export intern
(defun ensure-package (name &key recycle mix reexport
nicknames documentation use unintern)
shadow shadowing-import-from (macrolet ((when-fishy (&body body)
import-from export intern `(when *all-package-fishiness* ,@body))
recycle mix reexport (fishy (&rest info)
unintern) `(when-fishy (record-fishy (list ,@info)))))
(let* ((name (string name)) (let* ((name (string name))
(nicknames (mapcar #'string nicknames)) (nicknames (mapcar #'string nicknames))
(names (cons name nicknames)) (names (cons name nicknames))
...@@ -579,15 +579,18 @@ or when loading the package is optional." ...@@ -579,15 +579,18 @@ or when loading the package is optional."
(apply 'ensure-package ',(parse-define-package-form package clauses)))) (apply 'ensure-package ',(parse-define-package-form package clauses))))
;;; Final tricks to keep various implementations happier ;;;; Final tricks to keep various implementations happy.
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
#+allegro #+allegro
(setf excl::*autoload-package-name-alist* (setf excl::*autoload-package-name-alist*
(remove "asdf" excl::*autoload-package-name-alist* (remove "asdf" excl::*autoload-package-name-alist*
:test 'equalp :key 'car)) ; We need that BEFORE any mention of package ASDF. :test 'equalp :key 'car)) ; We need that BEFORE any mention of package ASDF.
(unless (member :asdf2.27 *features*) #+(or clisp xcl)
#+(or clisp xcl) (unless (let ((vs (find-symbol* 'version-satisfies :asdf nil))
(progn (av (find-symbol* 'asdf-version :asdf nil)))
(when (find-package :asdf) (and vs av (funcall vs (funcall av) "2.26.59")))
(delete-package* :asdf t)) (when (find-package :asdf)
(make-package :asdf :use ())))) (delete-package* :asdf t))
(make-package :asdf :use ())))
...@@ -271,7 +271,7 @@ actually-existing directory." ...@@ -271,7 +271,7 @@ actually-existing directory."
:defaults defaults)) :defaults defaults))
(defmacro with-pathname-defaults ((&optional defaults) &body body) (defmacro with-pathname-defaults ((&optional defaults) &body body)
`(let ((*default-pathname-defaults* ,(or defaults (nil-pathname)))) ,@body)) `(let ((*default-pathname-defaults* ,(or defaults '(nil-pathname)))) ,@body))
(defun* truename* (p) (defun* truename* (p)
;; avoids both logical-pathname merging and physical resolution issues ;; avoids both logical-pathname merging and physical resolution issues
......
...@@ -211,20 +211,34 @@ upgrade_tags () { ...@@ -211,20 +211,34 @@ upgrade_tags () {
if [ -n "$TEST_ASDF_TAGS" ] ; then if [ -n "$TEST_ASDF_TAGS" ] ; then
echo $TEST_ASDF_TAGS ; return echo $TEST_ASDF_TAGS ; return
fi fi
# REQUIRE is a magic tag meaning whatever your implementation provides
# 1.37 is the last release by Daniel Barlow # 1.37 is the last release by Daniel Barlow
# 1.97 is the last release before Gary King takes over # 1.97 is the last release before Gary King takes over
# 1.369 is the last release by Gary King # 1.369 is the last release by Gary King
# 2.000 to 2.019 and 2.20 to 2.27 and beyond are Faré's "stable" releases # 2.000 to 2.019 and 2.20 to 2.27 and beyond are Faré's "stable" releases
echo 1.37 1.97 1.369 # 2.26.61 is the last single-package ASDF.
echo REQUIRE 1.37 1.97 1.369 2.26.61
git tag -l '2.0??' git tag -l '2.0??'
git tag -l '2.??' git tag -l '2.??'
} }
upgrade_methods () {
if [ -n "$TEST_ASDF_METHODS" ] ; then
echo $TEST_ASDF_METHODS ; return
fi
cat <<EOF
'load-asdf-lisp'load-asdf-system
'load-asdf-lisp'compile-load-asdf
'load-asdf-lisp'load-asdf-fasl
()'load-asdf-fasl
EOF
}
extract_tagged_asdf () { extract_tagged_asdf () {
ver=$1 ver=$1
if [ REQUIRE = "$ver" ] ; then return 0 ; fi
file=build/asdf-${tag}.lisp ; file=build/asdf-${tag}.lisp ;
if [ ! -f $file ] ; then if [ ! -f $file ] ; then
case $ver in case $ver in
1.*|2.0*|2.2[0-6]) 1.*|2.0*|2.2[0-6]|2.26.61)
git show ${tag}:asdf.lisp > $file ;; git show ${tag}:asdf.lisp > $file ;;
*) *)
echo "Don't know how to extract asdf.lisp for version $tag" echo "Don't know how to extract asdf.lisp for version $tag"
...@@ -243,7 +257,7 @@ valid_upgrade_test_p () { ...@@ -243,7 +257,7 @@ valid_upgrade_test_p () {
# my old ubuntu clisp 2.44.1 is wired in with an antique ASDF 1 from CLC that can't be downgraded. # my old ubuntu clisp 2.44.1 is wired in with an antique ASDF 1 from CLC that can't be downgraded.
# 2.00[0-7] use UID, which fails on that CLISP and was removed afterwards. # 2.00[0-7] use UID, which fails on that CLISP and was removed afterwards.
# Note that for the longest time, CLISP has included 2.011 in its distribution. # Note that for the longest time, CLISP has included 2.011 in its distribution.
: ;; : ;;
cmucl:1.*|cmucl:2.00*|cmucl:2.01[0-4]:*) cmucl:1.*|cmucl:2.00*|cmucl:2.01[0-4]:*)
: Skip, CMUCL has problems before 2.014.7 due to source-registry upgrade ;; : Skip, CMUCL has problems before 2.014.7 due to source-registry upgrade ;;
ecl*:1.*|ecl*:2.0[01]*|ecl*:2.20:*) ecl*:1.*|ecl*:2.0[01]*|ecl*:2.20:*)
...@@ -256,16 +270,17 @@ valid_upgrade_test_p () { ...@@ -256,16 +270,17 @@ valid_upgrade_test_p () {
*) return 0 ;; *) return 0 ;;
esac esac
return 1 return 1
} }
run_upgrade_tests () { run_upgrade_tests () {
su=test/script-support.lisp su=test/script-support.lisp
lv="$command $eval (load\"$su\") $eval" ;
for tag in `upgrade_tags` ; do for tag in `upgrade_tags` ; do
for x in load-asdf-system load-asdf-lisp compile-load-asdf load-asdf-fasl just-load-asdf-fasl ; do for method in `upgrade_methods` ; do
if valid_upgrade_test_p $lisp $tag $x ; then if valid_upgrade_test_p $lisp $tag $method ; then
echo "Testing upgrade from ASDF ${tag} using method $x" ; echo "Testing ASDF upgrade from ${tag} using method $method"
$lv "(asdf-test::test-upgrade 'asdf-test::$x \"$tag\")" || extract_tagged_asdf $tag
{ echo "upgrade FAILED for $lisp from $tag using method $x" ; exit 1 ;} $command $eval \
"'(#.(load\"$su\")#.(in-package :asdf-test)#.(test-upgrade $method \"$tag\"))" ||
{ echo "upgrade FAILED for $lisp from $tag using method $method" ; exit 1 ;}
fi ; done ; done 2>&1 | tee build/results/${lisp}-upgrade.text fi ; done ; done 2>&1 | tee build/results/${lisp}-upgrade.text
} }
run_tests () { run_tests () {
......
...@@ -345,13 +345,20 @@ is bound, write a message and exit on an error. If ...@@ -345,13 +345,20 @@ is bound, write a message and exit on an error. If
(register-directory *test-directory*) (register-directory *test-directory*)
(acall :oos (asym :load-op) x :verbose verbose))) (acall :oos (asym :load-op) x :verbose verbose)))
(defun test-upgrade (method tag) ;; called by run-test (defun test-upgrade (old-method new-method tag) ;; called by run-test
(with-test () (with-test ()
(unless (eq method 'just-load-asdf-fasl) (when old-method
(format t "Loading old asdf ~A~%" tag) (cond
(load-asdf-lisp tag)) ((equal tag "REQUIRE")
(format t "Loading new asdf with method ~A~%" method) (format t "Requiring some previous asdf ~A~%" tag)
(funcall method) (ignore-errors (funcall 'require "asdf"))
(unless (member "ASDF" *modules* :test 'equal)
(leave-test "Your Lisp implementation does not provide ASDF. Skipping test.~%" 0)))
(t
(format t "Loading old asdf ~A via ~A~%" tag old-method)
(funcall old-method tag))))
(format t "Now loading new asdf via method ~A~%" new-method)
(funcall new-method)
(format t "Testing it~%") (format t "Testing it~%")
(register-directory *test-directory*) (register-directory *test-directory*)
(load-test-system :test-module-depend) (load-test-system :test-module-depend)
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "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.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 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.98") (asdf-version "2.26.99")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version))) (already-there (equal asdf-version existing-version)))
......
...@@ -34,7 +34,7 @@ ...@@ -34,7 +34,7 @@
(defun undefine-function (function-spec) (defun undefine-function (function-spec)
(cond (cond
((symbolp function-spec) ((symbolp function-spec)
#+clisp #+(and clisp (or))
(let ((f (and (fboundp function-spec) (fdefinition function-spec)))) (let ((f (and (fboundp function-spec) (fdefinition function-spec))))
(when (typep f 'clos:standard-generic-function) (when (typep f 'clos:standard-generic-function)
(loop :for m :in (clos:generic-function-methods f) (loop :for m :in (clos:generic-function-methods f)
...@@ -51,7 +51,12 @@ ...@@ -51,7 +51,12 @@
((defdef (def* def) ((defdef (def* def)
`(defmacro ,def* (name formals &rest rest) `(defmacro ,def* (name formals &rest rest)
`(progn `(progn
#-clisp ;; clisp is unhappy about fmakunbound. ;; undefining the previous function is the portable way
;; of overriding any incompatible previous gf, but somehow
;; this causes CLISP to fail to see COMPONENT-NAME methods after ugprade
;; so instead, for CLISP we delete-package* in package.lisp
;; any time the API changes.
#-clisp
(undefine-function ',name) (undefine-function ',name)
#-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-( #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl ,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
......
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