Commit 4d044968 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.014.2: support XCL. Tweak testing infrastructure for it.

Also, use coerce-pathname in asdf-ecl and deprecate merge-component-name-type.
parent 7555df6d
system := "asdf"
#user := $(shell basename `echo "$home"`)
user := "frideau"
webhome_private := $(user)@common-lisp.net:/project/asdf/public_html/
ifeq (${user},)
userat :=
else
userat := ${user}@
endif
webhome_private := ${userat}common-lisp.net:/project/asdf/public_html/
webhome_public := "http://common-lisp.net/project/asdf/"
clnet_home := "/project/asdf/public_html/"
gpg := /home/fare/bin/dpkg-gpg
sourceDirectory := $(shell pwd)
lisps ?= ccl clisp sbcl ecl allegro abcl scl
lisps ?= ccl clisp sbcl ecl abcl allegro scl
## not tested by me: allegromodern cmucl lispworks
## will pass tests but not return proper exit value: xcl 0.0.0.291
## FAIL: gclcvs (condition handling)
## maybe supported by asdf, not supported yet by our tests: cormancl mcl genera
......@@ -26,7 +31,7 @@ archive:
archive-copy: archive
git checkout release
bin/rsync-cp tmp/asdf*.tar.gz $(webhome_private)/archives
bin/link-tarball $(clnet_home) $(user)
bin/link-tarball $(clnet_home) ${user}
bin/rsync-cp tmp/asdf.lisp $(webhome_private)
${MAKE} push
......@@ -79,11 +84,13 @@ do-test:
test: do-test test-forward-references
test-all: test-forward-references test-upgrade
do-test-all:
@for lisp in ${lisps} ; do \
make do-test lisp=$$lisp || exit 1 ; \
done
test-all: test-forward-references test-upgrade do-test-all
debian-package: mrproper
RELEASE="$$(git tag -l '2.0[0-9][0-9]' | tail -n 1)" ; \
git-buildpackage --git-debian-branch=release --git-upstream-branch=$$RELEASE --git-tag --git-retag --git-ignore-branch -sgpg -p${gpg}
......@@ -107,9 +114,13 @@ fix-local-git-tags:
fix-remote-git-tags:
for i in ${WRONGFUL_TAGS} ; do git push $${REMOTE:-cl.net} :refs/tags/$$i ; done
TODO:
exit 2
release: TODO test-all test-on-other-machines-too debian-changelog debian-package send-mail-to-mailing-lists
.PHONY: install archive archive-copy push website clean mrproper \
upgrade-test test-forward-references test do-test test-all \
debian-package \
upgrade-test test-forward-references test do-test test-all do-test-all \
debian-package release \
replace-sbcl-asdf replace-ccl-asdf \
fix-local-git-tags fix-remote-git-tags
......@@ -320,7 +320,7 @@
(defclass compiled-file (component) ())
(defmethod component-relative-pathname ((component compiled-file))
(compile-file-pathname
(merge-component-name-type
(coerce-pathname
(or (slot-value component 'relative-pathname)
(component-name component))
:type "fas")))
......
......@@ -3,7 +3,7 @@
;;; ;;;
;;; Free Software available under an MIT-style license. ;;;
;;; ;;;
;;; Copyright (c) 2001-2010 Daniel Barlow and contributors ;;;
;;; Copyright (c) 2001-2011 Daniel Barlow and contributors ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -12,7 +12,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.014.1" ;; to be automatically updated by bin/bump-revision
:version "2.014.2" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components
((:file "asdf")
......
;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.014.1: Another System Definition Facility.
;;; This is ASDF 2.014.2: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......@@ -19,7 +19,7 @@
;;; http://www.opensource.org/licenses/mit-license.html on or about
;;; Monday; July 13, 2009)
;;;
;;; Copyright (c) 2001-2010 Daniel Barlow and contributors
;;; Copyright (c) 2001-2011 Daniel Barlow and contributors
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
;;; a copy of this software and associated documentation files (the
......@@ -99,7 +99,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.014.1")
(asdf-version "2.014.2")
(existing-asdf (fboundp 'find-system))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
......@@ -361,7 +361,7 @@
(defun asdf-version ()
"Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.:
(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.013\")."
(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.345\")."
*asdf-version*)
(defvar *resolve-symlinks* t
......@@ -403,8 +403,9 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
`(defmacro ,def* (name formals &rest rest)
`(progn
#+(or ecl gcl) (fmakunbound ',name)
,(when (and #+ecl (symbolp name))
`(declaim (notinline ,name))) ; fails for setf functions on ecl
#-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
,(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
`(declaim (notinline ,name)))
(,',def ,name ,formals ,@rest)))))
(defdef defgeneric* defgeneric)
(defdef defun* defun))
......@@ -528,7 +529,7 @@ and NIL NAME, TYPE and VERSION components"
(defun* last-char (s)
(and (stringp s) (plusp (length s)) (char s (1- (length s)))))
(defun* asdf-message (format-string &rest format-args)
(declare (dynamic-extent format-args))
(apply #'format *verbose-out* format-string format-args))
......@@ -622,7 +623,7 @@ pathnames."
(defun* getenv (x)
(declare (ignorable x))
#+(or abcl clisp) (ext:getenv x)
#+(or abcl clisp xcl) (ext:getenv x)
#+allegro (sys:getenv x)
#+clozure (ccl:getenv x)
#+(or cmu scl) (cdr (assoc x ext:*environment-list* :test #'string=))
......@@ -635,7 +636,7 @@ pathnames."
(unless (ccl:%null-ptr-p value)
(ccl:%get-cstring value))))
#+sbcl (sb-ext:posix-getenv x)
#-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl)
#-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl xcl)
(error "getenv not available on your implementation"))
(defun* directory-pathname-p (pathname)
......@@ -967,12 +968,12 @@ processed in order by OPERATE."))
(when *upgraded-p*
(when (find-class 'module nil)
(eval
`(defmethod update-instance-for-redefined-class :after
'(defmethod update-instance-for-redefined-class :after
((m module) added deleted plist &key)
(declare (ignorable deleted plist))
(when (or *asdf-verbose* *load-verbose*)
(asdf-message (compatfmt "~&~@<; ~@;Updating ~A for ASDF ~A~@:>~%")
m ,(asdf-version)))
m (asdf-version)))
(when (member 'components-by-name added)
(compute-module-components-by-name m))
(when (typep m 'system)
......@@ -1572,12 +1573,14 @@ Host, device and version components are taken from DEFAULTS."
(values filename type))
(t
(split-name-type filename)))
(make-pathname :directory `(,relative ,@path) :name name :type type
(make-pathname :directory (cons relative path) :name name :type type
#-xcl #-xcl ;; 0.0.0.291 has a bug, behaves like merge-pathnames.
:defaults (or defaults *default-pathname-defaults*)))))))
(defun* merge-component-name-type (name &key type defaults)
;; For backwards compatibility only, for people using internals.
;; Will be removed in a future release, e.g. 2.014.
;; Will be removed in a future release, e.g. 2.016.
(warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
(coerce-pathname name :type type :defaults defaults))
(defmethod component-relative-pathname ((component component))
......@@ -2591,7 +2594,10 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(list "-c" command)
:input nil :output *verbose-out*))
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl)
#+xcl
(ext:run-shell-command command)
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl xcl)
(error "RUN-SHELL-COMMAND not implemented for this Lisp")))
;;;; ---------------------------------------------------------------------------
......@@ -2644,7 +2650,7 @@ located."
(:ccl :clozure)
(:corman :cormanlisp)
(:lw :lispworks)
:clisp :cmu :ecl :gcl :sbcl :scl :symbolics))
:clisp :cmu :ecl :gcl :sbcl :scl :symbolics :xcl))
(defparameter *os-features*
'((:win :windows :mswindows :win32 :mingw32) ;; shorten things on windows
......@@ -3142,7 +3148,7 @@ directive.")
(defparameter *output-translations-directory* (coerce-pathname "asdf-output-translations.conf.d/"))
(defun* user-output-translations-pathname ()
(in-user-configuration-directory *output-translations-file* ))
(in-user-configuration-directory *output-translations-file*))
(defun* system-output-translations-pathname ()
(in-system-configuration-directory *output-translations-file*))
(defun* user-output-translations-directory-pathname ()
......@@ -3519,28 +3525,30 @@ with a different configuration, so the configuration would be re-read then."
(defun subdirectories (directory)
(let* ((directory (ensure-directory-pathname directory))
#-(or cormanlisp genera)
#-(or cormanlisp genera xcl)
(wild (merge-pathnames*
#-(or abcl allegro cmu lispworks scl)
#-(or abcl allegro cmu lispworks scl xcl)
*wild-directory*
#+(or abcl allegro cmu lispworks scl) "*.*"
#+(or abcl allegro cmu lispworks scl xcl) "*.*"
directory))
(dirs
#-(or cormanlisp genera)
#-(or cormanlisp genera xcl)
(ignore-errors
(directory* wild . #.(or #+clozure '(:directories t :files nil)
#+mcl '(:directories t))))
#+cormanlisp (cl::directory-subdirs directory)
#+genera (fs:directory-list directory))
#+(or abcl allegro cmu genera lispworks scl)
(dirs (remove-if-not #+abcl #'extensions:probe-directory
#+allegro #'excl:probe-directory
#+lispworks #'lw:file-directory-p
#+genera #'(lambda (x) (getf (cdr x) :directory))
#-(or abcl allegro genera lispworks) #'directory-pathname-p
dirs))
#+genera
(dirs (mapcar #'(lambda (x) (ensure-directory-pathname (first x))) dirs)))
#+genera (fs:directory-list directory)
#+xcl (system:list-directory directory))
#+(or abcl allegro cmu genera lispworks scl xcl)
(dirs (loop :for x :in dirs
:for d = #+(or abcl xcl) (extensions:probe-directory x)
#+allegro (excl:probe-directory x)
#+(or cmu scl) (directory-pathname-p x)
#+genera (getf (cdr x) :directory)
#+lispworks (lw:file-directory-p x)
:when d :collect #+(or abcl allegro xcl) d
#+genera (ensure-directory-pathname (first x))
#+(or cmu lispworks scl) x)))
dirs))
(defun collect-sub*directories (directory collectp recursep collector)
......
#!/bin/sh
if [ -z $1 ]; then
if [ -n $1 ]; then
clnet_home="$1"
else
echo "Remote directory must be specified."
exit 1
exit 2
fi
if [ -z $2 ]; then
echo "Remote username must be specified."
exit 1
if [ -n "$2" ]; then
user="${2}@"
else
echo "Remote username not specified"
echo "Assuming remote user is same as local"
echo "and/or you configured your .ssh/config with:"
echo "Host common-lisp.net"
echo " User = foo"
fi
clnet_home="$1"
user=$2
tarball=`ls tmp/asdf*.tar.gz`
tarball=`basename $tarball`
latest="asdf.tar.gz"
echo "Link $tarball to $latest"
ssh $user@common-lisp.net "rm -f $clnet_home$latest; \
ssh ${user}common-lisp.net "rm -f $clnet_home$latest; \
ln -s $clnet_home/archives/$tarball $clnet_home$latest"
user=frideau
website:=${user}@common-lisp.net:/project/asdf/public_html/
#user=frideau
ifeq (${user},)
userat :=
else
userat := ${user}@
endif
website:=${userat}common-lisp.net:/project/asdf/public_html/
output = asdf.html asdf asdf.pdf asdf.info
webfiles = index.html .htaccess style.css cclan.png lisp-logo120x80.png favicon.ico ${output}
intermediate = asdf.cps asdf.log asdf.vr asdf.aux asdf.fn asdf.toc asdf.vrs \
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
;;; test asdf pathname specifications
......
......@@ -33,7 +33,7 @@
(cond
(errors-p
(leave-lisp "Testsuite failed: ASDF compiled with ERRORS" 2))
#-ecl ;; ECL 11.1.1 has spurious warnings
#-(or ecl xcl) ;; ECL 11.1.1 has spurious warnings, same with XCL 0.0.0.291
(warnings-p
(leave-lisp "Testsuite failed: ASDF compiled with warnings" 1))
(t
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
;;; test asdf run-shell-command function
;;; Stas Boukarev found (and fixed) a bug where on clisp asdf:run-shell-command might not return
;;; the right value. This attempts to test for that.
(unless (some #'(lambda (x) (member x *features*))
'(:win :windows :mswindows :win32 :mingw32))
(quit-on-error
(assert (eql 1 (asdf:run-shell-command "false")))
(quit-on-error
(unless (or #+asdf-windows t)
(assert (eql #-xcl 1 #+xcl 256 (asdf:run-shell-command "false")))
(assert (eql 0 (asdf:run-shell-command "true")))))
......@@ -158,6 +158,10 @@ case "$lisp" in
flags="-noinit"
nodebug="-batch"
eval="-eval" ;;
xcl)
command="${XCL:-xcl}"
flags="--no-userinit --no-siteinit"
eval="--eval" ;;
*)
echo "Unsupported lisp: $1" >&2
echo "Please add support to run-tests.sh" >&2
......
......@@ -31,7 +31,8 @@
#+gcl :gcl
#+lispworks :lispworks
#+sbcl :sbcl
#+scl :scl))))
#+scl :scl
#+xcl :xcl))))
(merge-pathnames
(make-pathname :directory `(:relative "tmp" "fasls" ,impl)
:defaults *asdf-directory*)
......@@ -43,8 +44,7 @@
#+allegro
(setf excl:*warn-on-nested-reader-conditionals* nil)
;;; code adapted from cl-launch (any errors in transcription are mine!)
;; http://www.cliki.net/cl-launch
;;; code adapted from cl-launch http://www.cliki.net/cl-launch
(defun leave-lisp (message return)
(fresh-line *error-output*)
(when message
......@@ -70,6 +70,11 @@
(sb-ext:quit :unix-status return)
#+abcl
(ext:quit :status return)
#+xcl
(progn
(unless (zerop return)
(format *error-output* "~&XCL won't let me exit with error return code ~D~%" return))
(ext:quit))
(error "Don't know how to quit Lisp; wanting to use exit code ~a" return))
......@@ -82,16 +87,16 @@ is bound, write a message and exit on an error. If
*asdf-test-debug* is true, enter the debugger."
(handler-bind
((error (lambda (c)
(format *error-output* "~a" c)
(format *error-output* "~&~a~&" c)
(cond
((ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST"))
(break))
(t
(format *error-output* "ABORTING:~% ~S~%" c)
(format *error-output* "~&ABORTING:~% ~S~%" c)
#+sbcl (sb-debug:backtrace 69)
#+clozure (ccl:print-call-history :count 69 :start-frame-number 1)
#+clisp (system::print-backtrace)
(format *error-output* "ABORTING:~% ~S~%" c)
(format *error-output* "~&ABORTING:~% ~S~%" c)
(leave-lisp "~&Script failed~%" 1))))))
(funcall thunk)
(leave-lisp "~&Script succeeded~%" 0)))
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package :asdf)
(defparameter *test-directory*
(merge-pathnames*
(make-pathname :directory '(:relative "tmp"))
cl-user::*asdf-directory*))
(merge-pathnames* (coerce-pathname "tmp/") cl-user::*asdf-directory*))
(defun under-test-directory (designator &optional (defaults *test-directory*))
(namestring (merge-pathnames* (merge-component-name-type designator) defaults)))
(namestring (merge-pathnames* (coerce-pathname designator) defaults)))
(defun create-conf-files (&optional (path *test-directory*))
(let ((v `(("conf.d/conf1.conf"
......@@ -115,6 +113,9 @@
(assert (find-system :foo8 nil))
(assert (not (find-system :foo9 nil)))
(format t "~&A: ~S~%B: ~S~%"
(namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-test-directory "dir2/bar/baz.lisp"))
(assert
(equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(under-test-directory "dir2/bar/baz.lisp")))
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
......@@ -6,7 +6,7 @@
;;; fasl when the source file is lost.
;;;---------------------------------------------------------------------------
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
;;;---------------------------------------------------------------------------
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
......@@ -2,7 +2,7 @@
;;; check that added nesting via modules doesn't confuse ASDF
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package #:common-lisp-user)
......
;;; -*- Lisp -*-
(in-package :cl-user)
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(defun module () 1)
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
......@@ -2,7 +2,7 @@
;;; test asdf:try-recompiling restart
(load "script-support")
(load "script-support.lisp")
(load-asdf)
;(trace asdf::find-component)
;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
......@@ -3,7 +3,7 @@
;;; test system def reloading if touched
;;; system that can be found using *system-definition-search-functions*
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(flet ((system-load-time (name)
......
......@@ -3,7 +3,7 @@
;;; test system def reloading if touched
;;; system that canNOT be found using *system-definition-search-functions*
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(flet ((system-load-time (name)
......
......@@ -2,7 +2,7 @@
;;; test asdf:try-recompiling restart
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(defvar *caught-error* nil)
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
#+scl
(require :http-library)
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
#+scl
(require :http-library)
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package :asdf)
(cl-user::quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(setf asdf:*central-registry* '(*default-pathname-defaults*))
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(format t "test2 1~%")
......
;;; -*- Lisp -*-
#+(or f1 f2) (error "This test cannot run if :f1 or :f2 are on *features*")
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package :asdf)
(cl-user::quit-on-error
......
;;; -*- Lisp -*-
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package :asdf)
(cl-user::quit-on-error
......
......@@ -2,7 +2,7 @@
;;; make sure we get a missing-component error
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package #:common-lisp-user)
......
......@@ -2,7 +2,7 @@
;;; make sure we get a missing-component-of-version error
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(in-package #:common-lisp-user)
......
;;; -*- Lisp -*-
(load "script-support")
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(load "../wild-modules")
(load "../wild-modules.lisp")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'wild-module))
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