Changeset 9861


Ignore:
Timestamp:
Jul 1, 2008, 5:15:00 PM (11 years ago)
Author:
gz
Message:

Make program-errors always cause an immediate error outside of file compilation.

For file compilation, the behavior is now controlled by a new :break-on-program-errors
argument to compile-file, defaulting from ccl::*fasl-break-on-program-errors*:

(defvar *fasl-break-on-program-errors* #+ccl-0711 nil #-ccl-0711 :defer

"Controls what happens when the compiler detects PROGRAM-ERROR's during file compilation.

If T, the compiler signals an error immediately when it detects the program-error.

If :DEFER, program errors are reported as compiler warnings, and in addition, an error

is signalled at the end of file compilation. This allows all warnings for the file
to be reported, but prevents the creation of a fasl file.

If NIL, program errors are treated the same as any other error condition detected by

the compiler, i.e. they are reported as compiler warnings and do not cause any
error to be signalled at compile time.")

Location:
branches/working-0711/ccl
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/nx0.lisp

    r9764 r9861  
    5050(defparameter *nx-hoist-declarations* t)
    5151(defparameter *nx-loop-nesting-level* 0)
     52(defvar *nx-break-on-program-errors* t)
    5253
    5354(defvar *nx1-vcells* nil)
     
    13611362          (setf (afunc-acode p) (nx1-lambda '(&rest args) `(args ,(runtime-program-error-form c)) nil)))
    13621363      (handler-bind ((warning (lambda (c)
    1363                                 (nx1-whine :program-error c)
    1364                                 (muffle-warning c)))
    1365                      (program-error (lambda (c)
    1366                                       (when (typep c 'compile-time-program-error)
    1367                                         (setq c (make-condition 'simple-program-error
    1368                                                   :format-control (simple-condition-format-control c)
    1369                                                   :format-arguments (simple-condition-format-arguments c))))
    1370                                       (nx1-whine :program-error c)
    1371                                       (throw 'program-error-handler c))))
     1364                                (nx1-whine :program-error c)
     1365                                (muffle-warning c)))
     1366                     (program-error (lambda (c)
     1367                                      (when *nx-break-on-program-errors*
     1368                                        (cerror "continue compilation ignoring this form" c))
     1369                                      (when (typep c 'compile-time-program-error)
     1370                                        (setq c (make-condition 'simple-program-error
     1371                                                                :format-control (simple-condition-format-control c)
     1372                                                                :format-arguments (simple-condition-format-arguments c))))
     1373                                      (unless *nx-break-on-program-errors*
     1374                                        (nx1-whine :program-error c))
     1375                                      (throw 'program-error-handler c))))
    13721376        (multiple-value-bind (body decls)
    13731377            (with-program-error-handler (lambda (c) (runtime-program-error-form c))
  • branches/working-0711/ccl/level-1/sysutils.lisp

    r9578 r9861  
    615615    (unless muffled
    616616      (setq any-p t)
    617       (unless (typep w 'style-warning) (setq harsh-p t))
     617      (unless (typep w 'style-warning)
     618        (unless (eq harsh-p :very)
     619          (setq harsh-p t)
     620          (when (and (typep w 'compiler-warning)
     621                     (eq (compiler-warning-warning-type w) :program-error)
     622                     (typep (car (compiler-warning-args w)) 'error))
     623            (setq harsh-p :very))))
    618624      (when (or init-p (not (equalp w-file last-w-file)))
    619625        (format s "~&;~A warnings " (if (null eval-p) "Compiler" "Interpreter"))
  • branches/working-0711/ccl/lib/compile-ccl.lisp

    r9578 r9861  
    601601         (cwd ,wd)))))
    602602
    603 (defun ensure-tests-loaded (&key force update)
     603(defun ensure-tests-loaded (&key force update ansi ccl)
    604604  (unless (and (find-package "REGRESSION-TEST") (not force))
    605605    (if (probe-file "ccl:tests;ansi-tests;")
     
    647647                 (function-definition-type)))
    648648      ;; This loads the actual tests
    649       (load "ccl:tests;ansi-tests;gclload2.lsp")
     649      (when ansi
     650        (load "ccl:tests;ansi-tests;gclload2.lsp"))
    650651      ;; And our own tests
    651       (load "ccl:tests;ansi-tests;ccl.lsp"))))
    652 
    653 (defun test-ccl (&key force (update t) verbose (catch-errors t))
     652      (when ccl
     653        (load "ccl:tests;ansi-tests;ccl.lsp")))))
     654
     655(defun test-ccl (&key force (update t) verbose (catch-errors t) (ansi t) (ccl t))
    654656  (with-preserved-working-directory ()
    655657    (let* ((*package* (find-package "CL-USER")))
    656       (ensure-tests-loaded :force force :update update)
     658      (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl)
    657659      (cwd "ccl:tests;ansi-tests;")
    658660      (let ((do-tests (find-symbol "DO-TESTS" "REGRESSION-TEST"))
    659             (*suppress-compiler-warnings* t)
    660661            (*print-catch-errors* nil))
    661662        (time (funcall do-tests :verbose verbose :compile t :catch-errors catch-errors)))
  • branches/working-0711/ccl/lib/nfcomp.lisp

    r9578 r9861  
    7474(defvar *fcomp-external-format* :default)
    7575
     76(defvar *fasl-break-on-program-errors* #+ccl-0711 nil #-ccl-0711 :defer
     77  "Controls what happens when the compiler detects PROGRAM-ERROR's during file compilation.
     78
     79  If T, the compiler signals an error immediately when it detects the program-error.
     80
     81  If :DEFER, program errors are reported as compiler warnings, and in addition, an error
     82    is signalled at the end of file compilation.  This allows all warnings for the file
     83    to be reported, but prevents the creation of a fasl file.
     84
     85  If NIL, program errors are treated the same as any other error condition detected by
     86   the compiler, i.e. they are reported as compiler warnings and do not cause any
     87   error to be signalled at compile time.")
     88 
     89
    7690(defvar *compile-print* nil ; Might wind up getting called *compile-FILE-print*
    7791  "The default for the :PRINT argument to COMPILE-FILE.")
     
    125139                         force
    126140                         compile-file-original-truename
    127                          (compile-file-original-buffer-offset 0))
     141                         (compile-file-original-buffer-offset 0)
     142                         (break-on-program-errors (if compile-file-original-truename
     143                                                    t  ;; really SLIME being interactive...
     144                                                    *fasl-break-on-program-errors*)))
    128145  "Compile INPUT-FILE, producing a corresponding fasl file and returning
    129146   its filename."
     
    135152        (restart-case
    136153         (return (%compile-file src output-file verbose print load features
    137                                 save-local-symbols save-doc-strings save-definitions save-source-locations force backend external-format
     154                                save-local-symbols save-doc-strings save-definitions
     155                                save-source-locations break-on-program-errors
     156                                force backend external-format
    138157                                compile-file-original-truename compile-file-original-buffer-offset))
    139158         (retry-compile-file ()
     
    145164
    146165(defun %compile-file (src output-file verbose print load features
    147                           save-local-symbols save-doc-strings save-definitions save-source-locations force target-backend external-format
     166                          save-local-symbols save-doc-strings save-definitions
     167                          save-source-locations break-on-program-errors
     168                          force target-backend external-format
    148169                          compile-file-original-truename compile-file-original-buffer-offset
    149170                          &aux orig-src)
     
    181202             (*fasl-save-doc-strings* save-doc-strings)
    182203             (*fasl-save-definitions* save-definitions)
     204             (*fasl-break-on-program-errors* break-on-program-errors)
    183205             (*fcomp-warnings-header* nil)
    184206             (*compile-file-pathname* orig-src)
     
    209231            (multiple-value-bind (any harsh) (report-deferred-warnings)
    210232              (setq *fasl-warnings-signalled-p* (or *fasl-warnings-signalled-p* any)
    211                     *fasl-non-style-warnings-signalled-p* (or *fasl-non-style-warnings-signalled-p* harsh))))
     233                    *fasl-non-style-warnings-signalled-p* (if (eq harsh :very) :very
     234                                                              (or *fasl-non-style-warnings-signalled-p* harsh)))))
     235          (when (and *fasl-break-on-program-errors* (eq *fasl-non-style-warnings-signalled-p* :very))
     236            (cerror "create the output file despite the errors"
     237                    "Serious errors encountered during compilation of ~s"
     238                    src))
    212239          (fasl-scan-forms-and-dump-file forms output-file lexenv)))
    213240      (when load (load output-file :verbose (or verbose *load-verbose*)))
    214241      (values (truename (pathname output-file))
    215242              *fasl-warnings-signalled-p*
    216               *fasl-non-style-warnings-signalled-p*))))
     243              (and *fasl-non-style-warnings-signalled-p* t)))))
    217244
    218245(defvar *fcomp-locked-hash-tables*)
     
    943970;;; making an lfun, but it's simpler this way...
    944971(defun fcomp-named-function (def name env &optional source-note)
    945   (let* ((env (new-lexical-environment env)))
     972  (let* ((env (new-lexical-environment env))
     973         (*nx-break-on-program-errors* (not (memq *fasl-break-on-program-errors* '(nil :defer)))))
    946974    (multiple-value-bind (lfun warnings)
    947975        (compile-named-function def
Note: See TracChangeset for help on using the changeset viewer.