Fix COMPILE and COMPILE-FILE secondary and tertiary return values

in case of successful completion with multiple invocations inside
a single WITH-COMPILATION-UNIT and failed previous invocations.

Found by: Robert Dodier (robert_dodier at yahoo dot com)
parent 5339a36d
......@@ -403,8 +403,8 @@
(type (pathname-type output-file))
(temp-file (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp"))
output-file))
(warnings-p t)
(failure-p t))
(warnings-p nil)
(failure-p nil))
(with-open-file (in input-file :direction :input)
(let* ((*compile-file-pathname* (pathname in))
(*compile-file-truename* (truename in))
......@@ -436,20 +436,26 @@
(%stream-terpri out)
(write (list 'setq '*source* *compile-file-truename*) :stream out)
(%stream-terpri out))
(loop
(let* ((*source-position* (file-position in))
(jvm::*source-line-number* (stream-line-number in))
(form (read in nil in))
(*compiler-error-context* form))
(when (eq form in)
(return))
(process-toplevel-form form out nil)))
(handler-bind ((style-warning #'(lambda (c)
(declare (ignore c))
(setf warnings-p t)
nil))
((or warning
compiler-error) #'(lambda (c)
(declare (ignore c))
(setf warnings-p t
failure-p t)
nil)))
(loop
(let* ((*source-position* (file-position in))
(jvm::*source-line-number* (stream-line-number in))
(form (read in nil in))
(*compiler-error-context* form))
(when (eq form in)
(return))
(process-toplevel-form form out nil))))
(dolist (name *fbound-names*)
(fmakunbound name)))))
(cond ((zerop (+ jvm::*errors* jvm::*warnings* jvm::*style-warnings*))
(setf warnings-p nil failure-p nil))
((zerop (+ jvm::*errors* jvm::*warnings*))
(setf failure-p nil))))
(fmakunbound name))))))
(rename-file temp-file output-file)
(when *compile-file-zip*
......
......@@ -8760,14 +8760,27 @@ for use with derive-type-times.")
(symbol-package name)
*package*))
compiled-function
(warnings-p t)
(failure-p t))
(warnings-p nil)
(failure-p nil))
(with-compilation-unit ()
(with-saved-compiler-policy
(let* ((tempfile (make-temp-file)))
(unwind-protect
(setf compiled-function
(load-compiled-function (compile-defun name expr env tempfile)))
(load-compiled-function
(handler-bind ((style-warning
#'(lambda (c)
(declare (ignore c))
(setf warnings-p t)
nil))
((or warning
compiler-error)
#'(lambda (c)
(declare (ignore c))
(setf warnings-p t
failure-p t)
nil)))
(compile-defun name expr env tempfile))))
(delete-file tempfile))))
(when (and name (functionp compiled-function))
(sys::%set-lambda-name compiled-function name)
......@@ -8780,11 +8793,7 @@ for use with derive-type-times.")
(setf (fdefinition name)
(if (macro-function name)
(make-macro name compiled-function)
compiled-function))))))
(cond ((zerop (+ *errors* *warnings* *style-warnings*))
(setf warnings-p nil failure-p nil))
((zerop (+ *errors* *warnings*))
(setf failure-p nil))))
compiled-function)))))))
(values (or name compiled-function) warnings-p failure-p))))
(defun jvm-compile (name &optional definition)
......
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