Commit 3dba0818 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

4.0.7.6: fix bugs discovered while testing, notably regarding pre-image dumping.

parent 4bb08411
......@@ -8,6 +8,7 @@ foo_require () {
t_env () {
[ -n "$BEGIN_TESTS" ] && return
export DOH=doh
export ASDF_OUTPUT_TRANSLATIONS="(:output-translations :inherit-configuration (\"$PWD\" (\"$PWD\" \"cache\")))"
TCURR=
BEGIN_TESTS='(in-package :cl-user)
;;(eval-when (:compile-toplevel) (format *trace-output* "~&Prologue compiled~%"))
......@@ -60,7 +61,7 @@ t_args () { ARGS="$ARGS $1" ;}
t_create () {
create_file 644 "$1" echo "$2"
TFILES="$TFILES $1" ;}
t_cleanup () { rm $TFILES ;}
t_cleanup () { rm $TFILES cache/* ; rmdir cache ;}
t_file () {
t_register "$(foo_require "$NUM:file" file)" $1
t_create $TFILE \
......@@ -151,7 +152,7 @@ t_make () {
}
t_check () {
echo "cl-launch $ARGS"
PATH=${PWD}:$PATH "$@" "won" | tee clt.log >&2
( PATH=${PWD}:$PATH "$@" "won" 2>&1) | tee clt.log >&2
: RESULTS: "$(cat clt.log)"
if [ -n "$TORIG" ] && [ -n "$TOUT" ] && ! cmp --quiet $TOUT $TORIG ; then
echo "the updated file differs from the original one, although execution might not show the difference. Double check that with:
......@@ -272,7 +273,7 @@ do_test () {
if [ -n "$num" ] ; then
NUM=$(printf "%02d" $num)
case "$*" in
*out*noupdate*)
*noupdate*)
# If we don't clean between runs of test/update, then
# we have bizarre transient failures at test 12 or 40 when we e.g.
# DEBUG_RACE_CONDITION=t cl-launch -l clisp -B tests 8 12
......@@ -291,7 +292,7 @@ test () {
tests $@ && test_clean
}
test_clean () {
rm -rfv clt* ~/.cache/common-lisp/*/$(pwd)/clt* >&2
rm -rfv clt* cache/ >&2
}
fakeccl () {
DO export LISP=ccl CCL=sbcl CCL_OPTIONS="--noinform --sysinit /dev/null --userinit /dev/null --eval (make-package':ccl) --eval (setf(symbol-function'ccl::quit)(symbol-function'sb-ext:quit)) --eval (setf(symbol-function'ccl::getenv)(symbol-function'sb-ext:posix-getenv))"
......
#!/bin/sh
#| cl-launch.sh -- shell wrapper generator for Common Lisp software -*- Lisp -*-
CL_LAUNCH_VERSION='4.0.7.5'
CL_LAUNCH_VERSION='4.0.7.6'
license_information () {
AUTHOR_NOTE="\
# Please send your improvements to the author:
......@@ -2280,9 +2280,9 @@ NIL
(defvar *cl-launch-file* nil) ;; name of this very file
(defvar *verbose* nil)
(defun dump-stream-to-file (i n)
(with-output-file (o n) (copy-stream-to-stream i o)))
(with-output-file (o n :if-exists :rename-and-delete) (copy-stream-to-stream i o)))
(defun dump-sexp-to-file (x n)
(with-output-file (o n) (write x :stream o :pretty t :readably t)))
(with-output-file (o n :if-exists :rename-and-delete) (write x :stream o :pretty t :readably t)))
(defvar *temporary-filenames* nil)
(defvar *temporary-file-prefix*
(format nil "~Acl-launch-~A-" *temporary-directory* (getenvp "CL_LAUNCH_PID")))
......@@ -2301,7 +2301,7 @@ NIL
(temporary-file-from-foo #'dump-stream-to-file i x))
(defun temporary-file-from-string (i x)
(temporary-file-from-foo
#'(lambda (i n) (with-output-file (o n) (princ i o))) i x))
#'(lambda (i n) (with-output-file (o n :if-exists :rename-and-delete) (princ i o))) i x))
(defun temporary-file-from-sexp (i x)
(temporary-file-from-foo #'dump-sexp-to-file i x))
(defun temporary-file-from-file (f x)
......@@ -2433,7 +2433,7 @@ Returns two values: the fasl path, and T if the file was (re)compiled"
;; Make a temporary system with given name stem and options
;; return the new list of dependencies, i.e. a singleton of the actual system name.
(let ((sys (strcat "cl-launch-" stem)))
(eval `(progn
(eval `(handler-bind ((warning #'muffle-warning))
(defsystem ,sys :pathname nil :depends-on ,(reverse rdeps) ,@options)
(defmethod input-files ((o operation) (s (eql (find-system ,sys))))
',(cl-launch-files))))
......@@ -2484,11 +2484,11 @@ Returns two values: the fasl path, and T if the file was (re)compiled"
(*in-compile* t)
#+ecl (c::*suppress-compiler-warnings* (not *verbose*))
#+ecl (c::*suppress-compiler-notes* (not *verbose*))
(*features* (remove :cl-launch *features*))
(header-file
(progn
#+(or ecl mkcl)
(when dump
(setf *features* (remove :cl-launch *features*))
(let* ((header
(or *compile-file-pathname* *load-pathname* (getenvp "CL_LAUNCH_HEADER"))))
(ensure-lisp-file header "header.lisp")))))
......@@ -2522,10 +2522,11 @@ Returns two values: the fasl path, and T if the file was (re)compiled"
(funcall (ensure-function ,(car restart) :package ,(cdr restart)))))
;; Provide a sensible timestamp
;; For SBCL and other platforms that die on dump-image, clean before the end:
:perform (image-op :before (o c) (cleanup-temporary-files))))))
:perform (image-op :before (o c)
(setf *features* (remove :cl-launched *features*))
(cleanup-temporary-files))))))
(load-sys program-sys) ;; Give quicklisp a chance to download things
(when dump
(setf *features* (remove :cl-launched *features*))
(operate op program-sys)))
(cleanup-temporary-files))
(unless dump
......@@ -2540,7 +2541,7 @@ Returns two values: the fasl path, and T if the file was (re)compiled"
(error "Couldn't find quicklisp in your home directory. ~
Go get it at http://www.quicklisp.org/beta/index.html"))))
(defun run (&key quicklisp source-registry build dump restart final init (quit 0))
(defun run (&key quicklisp source-registry build dump restart final init (quit t))
(pushnew :cl-launched *features*)
(compute-arguments)
(when source-registry (initialize-source-registry source-registry))
......
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