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

4.0.4: Try much harder to load ASDF. Improve release scripts, documentation.

parent 6a0b694e
#!/bin/sh #!/bin/sh
#| cl-launch.sh -- shell wrapper generator for Common Lisp software -*- Lisp -*- #| cl-launch.sh -- shell wrapper generator for Common Lisp software -*- Lisp -*-
CL_LAUNCH_VERSION='4.0.2.3' CL_LAUNCH_VERSION='4.0.4'
license_information () { license_information () {
AUTHOR_NOTE="\ AUTHOR_NOTE="\
# Please send your improvements to the author: # Please send your improvements to the author:
...@@ -176,8 +176,8 @@ We'd like to homestead the path /usr/bin/cl while we can, so that ...@@ -176,8 +176,8 @@ We'd like to homestead the path /usr/bin/cl while we can, so that
script authors can reasonably expect a script to work when it starts with: script authors can reasonably expect a script to work when it starts with:
#!/usr/bin/cl #!/usr/bin/cl
To work properly, cl-launch 4.0.2 depends on ASDF 3.0.1 or later, and on To work properly, cl-launch 4.0.4 depends on ASDF 3.0.1 or later, and
its portability layer UIOP to manage compilation and image life cycle. on its portability layer UIOP, to manage compilation and image life cycle.
The software is specified as the evaluation of code in several phases; The software is specified as the evaluation of code in several phases;
the distinction matters most for creating executable binaries, the distinction matters most for creating executable binaries,
...@@ -259,9 +259,9 @@ file. ...@@ -259,9 +259,9 @@ file.
provided with option -E --entry (compatible with buildapp), it will be called provided with option -E --entry (compatible with buildapp), it will be called
with one argument, being the list of arguments passed to the program, with one argument, being the list of arguments passed to the program,
not including argv[0], which is available on most implementations via the not including argv[0], which is available on most implementations via the
function uiop:argv0. Using either option, the argument may be a function name function uiop:argv0 (available in ASDF 3.1.2 and later). Using either option,
or a lambda expression, that is read from the current package (see below the argument may be a function name or a lambda expression, that is read from
option -p --package and -sp --system-patch). the current package (see below option -p --package and -sp --system-package).
Only one restart or entry function may be specified; if multiple are provided, Only one restart or entry function may be specified; if multiple are provided,
the last one provided overrides previous ones. If you want several functions the last one provided overrides previous ones. If you want several functions
to be called, you may DEFUN one that calls them and use it as a restart, to be called, you may DEFUN one that calls them and use it as a restart,
...@@ -484,7 +484,7 @@ To dump an image, make sure you have a license file in your target directory ...@@ -484,7 +484,7 @@ To dump an image, make sure you have a license file in your target directory
create a build script with create a build script with
echo '(hcl:save-image "lispworks" :environment nil)' > si.lisp echo '(hcl:save-image "lispworks" :environment nil)' > si.lisp
lispworks-6-1-0-x86-linux -siteinit - -init - -build si.lisp lispworks-6-1-0-x86-linux -siteinit - -init - -build si.lisp
LispWorks also requires that you have ASDF 3.1.0.86 or later; LispWorks also requires that you have ASDF 3.1.2 or later;
make sure you have it installed and configured in your source registry. make sure you have it installed and configured in your source registry.
Similarly, a mlisp image for allegro can be created as follows: Similarly, a mlisp image for allegro can be created as follows:
...@@ -2107,43 +2107,138 @@ cat<<'NIL' ...@@ -2107,43 +2107,138 @@ cat<<'NIL'
NIL NIL
":" 't #-cl-launch ;'; cl_fragment<<'NIL' ":" 't #-cl-launch ;'; cl_fragment<<'NIL'
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(setf *print-readably* nil ; allegro 5.0 notably will bork without this ;; Configure the printer
*print-level* nil (setf *print-readably* nil ; allegro 5.0 may bork without this
*load-verbose* nil *compile-verbose* nil *compile-print* nil *load-print* nil) *print-level* nil)
(handler-bind ((warning #'muffle-warning)) ;; Hush the compiler and loader.
(unless (member :asdf *features*) (setf *load-verbose* nil *compile-verbose* nil *compile-print* nil *load-print* nil)
(ignore-errors (funcall 'require "asdf"))) ;; The code below exemplifies how to try super-hard to load ASDF 3 from standard locations,
(unless (member :asdf *features*) ;; by trying nice methods first, then increasingly desperate ones.
(ignore-errors (load (merge-pathnames "common-lisp/asdf/build/asdf.lisp" (user-homedir-pathname))))) ;; Stage 1 is to load ASDF at all.
(unless (member :asdf *features*) ;; Stage 2 is to upgrade to whichever ASDF installation the user has configured (if any).
(ignore-errors (load "/usr/share/common-lisp/source/asdf/build/asdf.lisp"))) ;; Versions older than ASDF 3.1 need to be told about ~/common-lisp/
(unless (member :asdf *features*) ;; ASDF 1 has no output translation layer, so can be configured to load ASDF 3
(error "Could not load ASDF."))) ;; only if ASDF 3 is in a predictable place under the user's homedir, thus
;; ~/common-lisp/asdf/ or ~/.local/share/common-lisp/source/asdf/ only.
(in-package :asdf)) (block nil
NIL (let ((required-asdf-version "3.0.1")
":" 't #-cl-launch ;'; cl_fragment<<'NIL' (verbose *load-verbose*))
(eval-when (:compile-toplevel :load-toplevel :execute) (labels ((asdf-symbol (name)
(and (find-package :asdf) (find-symbol (string name) :asdf)))
;; In case we only have ASDF1 or ASDF2 so far, try harder. (asdf-call (name &rest args)
(unless (member :asdf3 *features*) (apply (asdf-symbol name) args))
(flet ((maybe-register (d) (asdf-version ()
(when (probe-file (merge-pathnames "asdf.asd" d)) (when (find-package :asdf)
(pushnew d *central-registry*) (or (symbol-value (or (asdf-symbol '*asdf-version*)
(pushnew (merge-pathnames "uiop/" d) *central-registry*)))) (asdf-symbol '*asdf-revision*)))
(or (let ((asdf (find-system "asdf" nil))) "1.0")))
(and asdf #+asdf2 (version-satisfies asdf "3.0.1"))) (maybe-display (message)
(maybe-register (merge-pathnames "common-lisp/asdf/" (user-homedir-pathname))) (when (and verbose message) (format t "~&~A~%" message)))
(maybe-register "/usr/share/common-lisp/source/asdf/")))) (call-maybe-verbosely (message function &rest args)
(cond
;; Make sure we use the latest ASDF available, if not 3.0.1 (verbose
(defparameter asdf::*asdf-verbose* nil) ; for old versions of ASDF such as XCL's 2.014.2 (maybe-display message)
(setf *load-verbose* nil asdf::*verbose-out* nil) (apply function args))
(unless (or #+asdf2 (asdf:version-satisfies (asdf:asdf-version) "3.0.1")) (t
(handler-bind ((warning #'muffle-warning)) #+abcl ;; Bug in ABCL 1.3.0: without this, loading asdf.fasl shows warnings
(let (#+(and abcl asdf3) ; Why does the above not suffice? (let* ((uc (asdf-symbol '*uninteresting-conditions*))
(uiop::*uninteresting-conditions* (cons 'warning uiop::*uninteresting-conditions*))) (vars (when uc (list uc)))
(operate 'load-op :asdf :verbose nil))))) (vals (when uc (list (cons 'warning (symbol-value uc))))))
(progv vars vals
(handler-bind ((warning #'muffle-warning))
(apply function args))))
#-abcl
(handler-bind ((warning #'muffle-warning))
(apply function args)))))
(try-stage-1 (message function)
(ignore-errors
(call-maybe-verbosely (format nil "Trying to ~A" message) function))
(maybe-done-stage-1))
(try-file-stage-1 (explanation pathname)
(try-stage-1 (format nil "load ASDF from ~A" explanation)
#'(lambda () (load pathname))))
(subpath (parent &key directory name type)
(merge-pathnames (make-pathname :defaults parent :version nil
:directory (cons :relative directory) :name name :type type)
parent))
(build/asdf.lisp (directory)
(subpath directory :directory '("build") :name "asdf" :type "lisp"))
(visible-default-user-asdf-directory ()
(subpath (user-homedir-pathname) :directory '("common-lisp" "asdf")))
(visible-default-user-asdf-lisp ()
(build/asdf.lisp (visible-default-user-asdf-directory)))
(hidden-default-user-asdf-directory ()
(subpath (user-homedir-pathname) :directory '(".local" "share" "common-lisp" "asdf")))
(hidden-default-user-asdf-lisp ()
(build/asdf.lisp (hidden-default-user-asdf-directory)))
(stage-1 () ;; Try to load ASDF at all, any ASDF.
(try-stage-1
;; Do nothing if ASDF is already loaded
"use an already loaded ASDF"
(constantly nil))
(try-stage-1
"require ASDF from the implementation"
;; Most implementations provide ASDF, but while most of them are case-insensitive,
;; CLISP is case-sensitive, so we need to specify a lowercase string,
;; and not the keyword :asdf or symbol 'asdf.
;; Most implementations provide ASDF 3, but some of them only ASDF 2
;; and antique versions only ASDF 1.
#'(lambda () (funcall 'require "asdf")))
(try-file-stage-1
"asdf/ under the default (visible) CL source directory ~/common-lisp/"
(visible-default-user-asdf-lisp))
(try-file-stage-1
"asdf/ under the default (hidden) CL source directory ~/.local/share/common-lisp/"
(hidden-default-user-asdf-lisp))
#+(or unix linux bsd)
(progn
(try-file-stage-1
"asdf/ under the local system CL source directory /usr/local/share/common-lisp/"
(build/asdf.lisp #p"/usr/local/share/common-lisp/asdf/"))
(try-file-stage-1
"asdf/ under the managed system CL source directory /usr/share/common-lisp/"
(build/asdf.lisp #p"/usr/share/common-lisp/asdf/"))
(try-file-stage-1
"cl-asdf/ under the managed system CL source directory /usr/share/common-lisp/"
(build/asdf.lisp #p"/usr/share/common-lisp/cl-asdf/")))
(error "Could not load ASDF."))
(maybe-done-stage-1 ()
;; If we have ASDF, then go to stage 2: have it upgrade itself.
(when (member :asdf *features*)
(maybe-display (format nil "Found ASDF ~A" (asdf-version)))
(stage-2))) ;; doesn't return.
(configure-asdf ()
;; configure older versions of ASDF, as needed
(cond
((probe-file (visible-default-user-asdf-lisp))
(unless (member :asdf3.1 *features*)
(maybe-display "Telling this old ASDF about your ~/common-lisp/asdf/")
(pushnew (visible-default-user-asdf-directory)
(symbol-value (asdf-symbol '*central-registry*)))))
((probe-file (hidden-default-user-asdf-lisp))
(unless (member :asdf2 *features*)
(maybe-display "Telling this antique ASDF about your ~/.local/share/common-lisp/asdf/")
(pushnew (hidden-default-user-asdf-directory)
(symbol-value (asdf-symbol '*central-registry*)))))))
(maybe-done-stage-2 ()
(when (ignore-errors (asdf-call 'version-satisfies
(asdf-version) required-asdf-version))
(when verbose
(format t "~&Victory! We now have ASDF ~A~%" (asdf-version)))
(return)))
(stage-2 ()
;; We have ASDF, now have it upgrade itself.
(configure-asdf)
(when (asdf-call 'find-system :asdf nil)
(call-maybe-verbosely
"Trying to upgrade ASDF"
(asdf-symbol 'operate) (asdf-symbol 'load-op) :asdf) :verbose nil)
(maybe-done-stage-2)
(error "We could only load ASDF ~A but we need ASDF ~A"
(asdf-version) required-asdf-version)))
(call-maybe-verbosely nil #'stage-1))))
(in-package :asdf))
NIL NIL
":" 't #-cl-launch ;'; cl_fragment<<'NIL' ":" 't #-cl-launch ;'; cl_fragment<<'NIL'
;; Because of ASDF upgrade punting, this ASDF package may be a new one. ;; Because of ASDF upgrade punting, this ASDF package may be a new one.
......
cl-launch (4.0.4-1) unstable; urgency=low
* Try even harder to load ASDF.
* Update documentation, version numbers, etc. Improve release.
-- Francois-Rene Rideau <fare@tunes.org> Sat, 26 Apr 2014 12:36:51 -0400
cl-launch (4.0.3-1) unstable; urgency=low cl-launch (4.0.3-1) unstable; urgency=low
* ~/common-lisp/ not ~/cl/ is where ASDF 3.1 standardizes * ~/common-lisp/ not ~/cl/ is where ASDF 3.1 standardizes
......
...@@ -2,92 +2,116 @@ ...@@ -2,92 +2,116 @@
#| -*- Lisp -*- #| -*- Lisp -*-
exec "$(dirname $0)/cl-launch.sh" \ exec "$(dirname $0)/cl-launch.sh" \
--system inferior-shell --system optima.ppcre \ --system inferior-shell --system optima.ppcre \
--package cl-launch-release --entry main -X -- "$0" "$@" ; exit -X --package cl-launch-release --entry main -- "$0" "$@" ; exit
NB: this script requires ASDF 3.1.0.87 or later, for argv0.
|# |#
(defpackage :cl-launch-release (defpackage :cl-launch-release
(:use :cl :uiop :asdf :inferior-shell :optima :optima.ppcre) (:use :cl :uiop :asdf :inferior-shell :optima :optima.ppcre)
;; Note: the exports are the list of available commands. ;; Note: the exports are the list of available commands.
(:export #:rep #:clean (:export #:rep #:clean
#:debian-package #:debian-package-all #:quickrelease)) #:debian-package #:publish-debian-package #:debian-package-all #:quickrelease))
(in-package :cl-launch-release) (in-package :cl-launch-release)
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(unless (fboundp 'argv0) (defun argv0 () "release.lisp")) ;; only in ASDF 3.1.2 or later
(flet ((check-system-version (name version) (flet ((check-system-version (name version)
(let ((system (find-system name))) (let ((system (find-system name)))
(unless (version-satisfies system version) (unless (version-satisfies system version)
(die 2 "~A requires ~A at least ~A but only got version ~A" (die 2 "~A requires ~A at least ~A but only got version ~A"
(argv0) name version (component-version system)))))) (argv0) name version (component-version system))))))
(check-system-version "inferior-shell" "2.0.0"))) (check-system-version "inferior-shell" "2.0.0"))) ;; for default run outputs
(defvar *cl-launch-directory* ;; interactive users may want to override that.
(truenamize
(pathname-directory-pathname
(ensure-absolute-pathname
(or (argv0) *load-pathname* (nil-pathname)) #'getcwd))))
(defun pn (&optional x)
(subpathname *cl-launch-directory* x))
(defun rep (argument) (eval-input argument)) ;; read-eval-print, no loop. (defun rep (argument)
;; read-eval-print, no loop.
(eval-input (strcat "(in-package :cl-launch-release) " argument)))
(defun script-version ()
(match (read-file-line (pn "cl-launch.sh") :at 2)
((ppcre "^CL_LAUNCH_VERSION='([0-9]+([.][0-9]+)+)'$" version) version)))
(defun debian-version () (defun debian-version ()
(match (read-file-line "debian/changelog" :at 0) (match (read-file-line (pn "debian/changelog") :at 0)
((ppcre "^[^(]*\\(([-0-9.]+)\\)" x) x))) ((ppcre "^[^(]*\\(([-0-9.]+)\\)" x) x)))
(defun debian-version-tag (&optional (version (debian-version))) (defun debian-version-tag (&optional (version (debian-version)))
(first (split-string version :separator "-"))) (first (split-string version :separator "-")))
(defun get-version ()
(let ((sv (script-version))
(dv (debian-version-tag)))
(unless (equal sv dv)
(error "version mismatch: cl-launch.sh says ~A whereas the debian/changelog says ~A" sv dv))
sv))
(defun debian-arch () (defun debian-arch ()
"amd64") "amd64")
(defun git-tag (&optional (pattern "4.*")) (defun git-tag (&optional (pattern "4.*"))
(run/ss `(git describe --tags --match ,pattern))) (with-current-directory ((pn))
(run/ss `(git describe --tags --match ,pattern))))
(defun clean () (defun clean ()
(run '(git clean -xfd)) (with-current-directory ((pn))
(run '(git clean -xfd)))
(values)) (values))
(defun debian-package () (defun debian-package ()
(clean) (let* ((debian-version (debian-version))
(let* ((version (debian-version)) (version (get-version))
(tag (debian-version-tag version)) (origtarball (pn (strcat "../cl-launch_" version ".orig.tar.gz"))))
(up (pathname-parent-directory-pathname (getcwd))) (with-current-directory ((pn))
(origtarball (subpathname up (strcat "cl-launch_" tag ".orig.tar.gz")))) (run `(pwd) :show t)
(delete-file-if-exists origtarball) (clean)
(run `(git-buildpackage --git-debian-branch=master --git-upstream-branch=master (--git-upstream-tag= ,tag) --git-tag --git-retag --git-ignore-branch) :show t) (delete-file-if-exists origtarball)
(run `(lintian -c --fail-on-warnings (../cl-launch_ ,version _ ,(debian-arch) .changes)) :show t)) (run `(git-buildpackage --git-debian-branch=master --git-upstream-branch=master (--git-upstream-tag= ,version) --git-tag --git-retag --git-ignore-branch) :show t)
(clean)) (run `(lintian -c --fail-on-warnings (../cl-launch_ ,debian-version _ ,(debian-arch) .changes)) :show t)
(clean))))
(defun debian-package-all () (defun publish-debian-package ()
(let* ((version (debian-version)) (let* ((version (get-version))
(tag (debian-version-tag version)) (debian-version (debian-version))
(up (pathname-parent-directory-pathname (getcwd)))
(home (user-homedir-pathname)) (home (user-homedir-pathname))
(cl-launch-tag (strcat "cl-launch-" tag)) (cl-launch-version (strcat "cl-launch-" version))
(cldir (subpathname home "files/cl-launch/"))) (cldir (subpathname home "files/cl-launch/")))
(debian-package) (with-current-directory ((pn))
(run `(./cl-launch.sh --include "." "-B" install_path) :show t) (run `(pwd) :show t)
(run `(./cl-launch.sh --no-include -o cl-launch "-B" install_bin) :show t) (run `(./cl-launch.sh --include "." "-B" install_path) :show t)
(with-current-directory (up) (run `(./cl-launch.sh --no-include -o cl-launch "-B" install_bin) :show t)
(run `(rm -f ,cl-launch-tag) :show t) (run `(cp ./cl-launch.sh (,cldir cl-launch.sh)) :show t))
(run `(ln -s cl-launch ,cl-launch-tag) :show t) (with-current-directory ((pn "../"))
(run `(tar zcfh (,cldir ,cl-launch-tag .tar.gz) (run `(pwd) :show t)
--exclude .git ,cl-launch-tag) :show t) (run `(rm -f ,cl-launch-version) :show t)
(run `(cp cl-launch/cl-launch.sh (,cldir cl-launch.sh)) :show t) (run `(ln -s cl-launch ,cl-launch-version) :show t)
(run (format nil "mv cl-launch_~A* ~A" tag cldir) :show t) (run `(tar zcfh (,cldir ,cl-launch-version .tar.gz)
(run `(rm -f ,cl-launch-tag) :show t)) --exclude .git (,cl-launch-version /)) :show t)
(run `(mv ,@(directory (merge-pathnames* (strcat "cl-launch_" version "*.*") (pn "../")))
,cldir) :show t)
(run `(rm -f ,cl-launch-version) :show t))
(with-current-directory (cldir) (with-current-directory (cldir)
(run `(ln -sf (cl-launch ,tag .tar.gz) cl-launch.tar.gz) :show t) (run `(pwd) :show t)
(run/interactive `(gpg -b -a (cl-launch- ,tag .tar.gz)) :show t) (run/interactive `(gpg -b -a (cl-launch- ,version .tar.gz)) :show t)
(run `(ln -sf (cl-launch- ,tag .tar.gz) cl-launch.tar.gz) :show t) (run `(ln -sf (,cl-launch-version .tar.gz) cl-launch.tar.gz) :show t)
(run `(ln -sf (cl-launch- ,tag .tar.gz.asc) cl-launch.tar.gz.asc) :show t) (run `(ln -sf (,cl-launch-version .tar.gz.asc) cl-launch.tar.gz.asc) :show t)
(run `(dput mentors (cl-launch_ ,version _ ,(debian-arch) .changes)) :show t) (run `(dput mentors (cl-launch_ ,debian-version _ ,(debian-arch) .changes)) :show t)
(run `(rsync -av --delete ,cldir "common-lisp.net:/project/xcvb/public_html/cl-launch/") :show t)) (run `(rsync -av --delete ,cldir "common-lisp.net:/project/xcvb/public_html/cl-launch/") :show t))
(values))) (values)))
(defun cl-launch-version ()
(match (read-file-line "cl-launch.sh" :at 2)
((ppcre "^CL_LAUNCH_VERSION='([0-9]+([.][0-9]+)+)'$" version) version)))
(defun quickrelease () (defun quickrelease ()
(let* ((version (cl-launch-version)) (let* ((version (script-version)) ;; no need to compare with the debian version
(link (strcat "cl-launch-" version)) (link (strcat "cl-launch-" version))
(tarball (strcat link ".tar.gz"))) (tarball (strcat link ".tar.gz")))
(with-current-directory ("../") (with-current-directory ((pn "../"))
(run `(pwd) :show t)
(clean)
(run `(rm -f ,link)) (run `(rm -f ,link))
(run `(ln -s cl-launch ,link)) (run `(ln -s cl-launch ,link))
(run `(tar zcfh ,tarball --exclude .git ,link)) (run `(tar zcfh ,tarball --exclude .git ,link))
...@@ -97,6 +121,10 @@ NB: this script requires ASDF 3.1.0.87 or later, for argv0. ...@@ -97,6 +121,10 @@ NB: this script requires ASDF 3.1.0.87 or later, for argv0.
(run `(rm -f ,link ,tarball)))) (run `(rm -f ,link ,tarball))))
(values)) (values))
(defun debian-package-all ()
(debian-package)
(publish-debian-package))
(defun valid-commands () (defun valid-commands ()
(sort (while-collecting (c) (do-external-symbols (x :cl-launch-release) (c x))) #'string<)) (sort (while-collecting (c) (do-external-symbols (x :cl-launch-release) (c x))) #'string<))
......
Supports Markdown
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