Changeset 11763


Ignore:
Timestamp:
04/18/09 19:08:08 (12 years ago)
Author:
ehuelsmann
Message:

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)

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r11719 r11763  
    404404         (temp-file (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp"))
    405405                                     output-file))
    406          (warnings-p t)
    407          (failure-p t))
     406         (warnings-p nil)
     407         (failure-p nil))
    408408    (with-open-file (in input-file :direction :input)
    409409      (let* ((*compile-file-pathname* (pathname in))
     
    437437                  (write (list 'setq '*source* *compile-file-truename*) :stream out)
    438438                  (%stream-terpri out))
    439                 (loop
    440                    (let* ((*source-position* (file-position in))
    441                           (jvm::*source-line-number* (stream-line-number in))
    442                           (form (read in nil in))
    443                           (*compiler-error-context* form))
    444                      (when (eq form in)
    445                        (return))
    446                      (process-toplevel-form form out nil)))
     439                (handler-bind ((style-warning #'(lambda (c)
     440                                                  (declare (ignore c))
     441                                                  (setf warnings-p t)
     442                                                  nil))
     443                               ((or warning
     444                                    compiler-error) #'(lambda (c)
     445                                                        (declare (ignore c))
     446                                                        (setf warnings-p t
     447                                                              failure-p t)
     448                                                        nil)))
     449                  (loop
     450                     (let* ((*source-position* (file-position in))
     451                            (jvm::*source-line-number* (stream-line-number in))
     452                            (form (read in nil in))
     453                            (*compiler-error-context* form))
     454                       (when (eq form in)
     455                         (return))
     456                       (process-toplevel-form form out nil))))
    447457                (dolist (name *fbound-names*)
    448                   (fmakunbound name)))))
    449           (cond ((zerop (+ jvm::*errors* jvm::*warnings* jvm::*style-warnings*))
    450                  (setf warnings-p nil failure-p nil))
    451                 ((zerop (+ jvm::*errors* jvm::*warnings*))
    452                  (setf failure-p nil))))
     458                  (fmakunbound name))))))
    453459        (rename-file temp-file output-file)
    454460
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11722 r11763  
    87618761                          *package*))
    87628762           compiled-function
    8763            (warnings-p t)
    8764            (failure-p t))
     8763           (warnings-p nil)
     8764           (failure-p nil))
    87658765      (with-compilation-unit ()
    87668766        (with-saved-compiler-policy
     
    87688768            (unwind-protect
    87698769                 (setf compiled-function
    8770                        (load-compiled-function (compile-defun name expr env tempfile)))
     8770                       (load-compiled-function
     8771                        (handler-bind ((style-warning
     8772                                        #'(lambda (c)
     8773                                            (declare (ignore c))
     8774                                            (setf warnings-p t)
     8775                                            nil))
     8776                                       ((or warning
     8777                                            compiler-error)
     8778                                        #'(lambda (c)
     8779                                            (declare (ignore c))
     8780                                            (setf warnings-p t
     8781                                                  failure-p t)
     8782                                            nil)))
     8783                          (compile-defun name expr env tempfile))))
    87718784              (delete-file tempfile))))
    87728785        (when (and name (functionp compiled-function))
     
    87818794                         (if (macro-function name)
    87828795                             (make-macro name compiled-function)
    8783                              compiled-function))))))
    8784         (cond ((zerop (+ *errors* *warnings* *style-warnings*))
    8785                (setf warnings-p nil failure-p nil))
    8786               ((zerop (+ *errors* *warnings*))
    8787                (setf failure-p nil))))
     8796                             compiled-function)))))))
    87888797      (values (or name compiled-function) warnings-p failure-p))))
    87898798
Note: See TracChangeset for help on using the changeset viewer.