Skip to content

Commit

Permalink
1.0.11.25: don't leave incomplete fasls around after compilation
Browse files Browse the repository at this point in the history
* CLHS says the first return value of COMPILE-FILE is
  NIL if "file could not be created" -- interpret this
  to mean "fasl could not be created" and don't count
  incomplete fasls as fasls.
  • Loading branch information
nikodemus committed Nov 17, 2007
1 parent 8188059 commit a0889b1
Show file tree
Hide file tree
Showing 5 changed files with 48 additions and 18 deletions.
2 changes: 2 additions & 0 deletions NEWS
Expand Up @@ -5,6 +5,8 @@ changes in sbcl-1.0.12 relative to sbcl-1.0.11:
concurrent accesses (but not iteration.) See also:
SB-EXT:WITH-LOCKED-HASH-TABLE, and
SB-EXT:HASH-TABLE-SYNCHRONIZED-P.
* bug fix: if file compilation is aborted, the partial fasl is now
deleted, and COMPILE-FILE returns NIL as the primary value.
* bug fix: number of thread safety issues relating to SBCL's internal
hash-table usage have been fixed.
* bug fix: SB-SYS:WITH-PINNED-OBJECTS could cause garbage values to
Expand Down
35 changes: 19 additions & 16 deletions src/compiler/main.lisp
Expand Up @@ -1482,7 +1482,7 @@
(invoke-restart it))))))))

;;; Read all forms from INFO and compile them, with output to OBJECT.
;;; Return (VALUES NIL WARNINGS-P FAILURE-P).
;;; Return (VALUES ABORT-P WARNINGS-P FAILURE-P).
(defun sub-compile-file (info)
(declare (type source-info info))
(let ((*package* (sane-package))
Expand All @@ -1503,7 +1503,7 @@
(*compiler-error-bailout*
(lambda ()
(compiler-mumble "~2&; fatal error, aborting compilation~%")
(return-from sub-compile-file (values nil t t))))
(return-from sub-compile-file (values t t t))))
(*current-path* nil)
(*last-source-context* nil)
(*last-original-source* nil)
Expand Down Expand Up @@ -1557,7 +1557,7 @@
"~@<compilation aborted because of fatal error: ~2I~_~A~:>"
condition))
(finish-output *error-output*)
(values nil t t)))))
(values t t t)))))

;;; Return a pathname for the named file. The file must exist.
(defun verify-source-file (pathname-designator)
Expand Down Expand Up @@ -1666,7 +1666,7 @@ SPEED and COMPILATION-SPEED optimization values, and the
|#
(let* ((fasl-output nil)
(output-file-name nil)
(compile-won nil)
(abort-p nil)
(warnings-p nil)
(failure-p t) ; T in case error keeps this from being set later
(input-pathname (verify-source-file input-file))
Expand Down Expand Up @@ -1697,31 +1697,34 @@ SPEED and COMPILATION-SPEED optimization values, and the

(when sb!xc:*compile-verbose*
(print-compile-start-note source-info))
(let ((*compile-object* fasl-output)
dummy)
(multiple-value-setq (dummy warnings-p failure-p)
(sub-compile-file source-info)))
(setq compile-won t))

(let ((*compile-object* fasl-output))
(setf (values abort-p warnings-p failure-p)
(sub-compile-file source-info))))

(close-source-info source-info)

(when fasl-output
(close-fasl-output fasl-output (not compile-won))
(close-fasl-output fasl-output abort-p)
(setq output-file-name
(pathname (fasl-output-stream fasl-output)))
(when (and compile-won sb!xc:*compile-verbose*)
(when (and (not abort-p) sb!xc:*compile-verbose*)
(compiler-mumble "~2&; ~A written~%" (namestring output-file-name))))

(when sb!xc:*compile-verbose*
(print-compile-end-note source-info compile-won))
(print-compile-end-note source-info (not abort-p)))

(when *compiler-trace-output*
(close *compiler-trace-output*)))

(values (if output-file
;; Hack around filesystem race condition...
(or (probe-file output-file-name) output-file-name)
nil)
;; CLHS says that the first value is NIL if the "file could not
;; be created". We interpret this to mean "a valid fasl could not
;; be created" -- which can happen if the compilation is aborted
;; before the whole file has been processed, due to eg. a reader
;; error.
(values (when (and (not abort-p) output-file)
;; Hack around filesystem race condition...
(or (probe-file output-file-name) output-file-name))
warnings-p
failure-p)))

Expand Down
8 changes: 7 additions & 1 deletion tests/compiler.test.sh
Expand Up @@ -372,8 +372,14 @@ cat > $tmpfilename <<EOF
EOF
expect_clean_compile $tmpfilename

cat > $tmpfilename <<EOF
(defun something (x) x)
...
(defun something-more (x) x)
EOF
expect_aborted_compile $tmpfilename

rm $tmpfilename
rm $compiled_tmpfilename

# success
exit 104
19 changes: 19 additions & 0 deletions tests/expect.sh
Expand Up @@ -83,6 +83,25 @@ EOF
fi
}

expect_aborted_compile ()
{
$SBCL <<EOF
(let* ((lisp "$1")
(fasl (compile-file-pathname lisp)))
(multiple-value-bind (pathname warnings-p failure-p)
(compile-file "$1" :print t)
(assert (not pathname))
(assert failure-p)
(assert warnings-p)
(assert (not (probe-file fasl))))
(sb-ext:quit :unix-status 52))
EOF
if [ $? != 52 ]; then
echo abort-compile $1 test failed: $?
exit 1
fi
}

fail_on_compiler_note ()
{
$SBCL <<EOF
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -17,4 +17,4 @@
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
"1.0.11.24"
"1.0.11.25"

0 comments on commit a0889b1

Please sign in to comment.