ccl icon indicating copy to clipboard operation
ccl copied to clipboard

simple-file-error is not given a :format-control :-(

Open informatimago opened this issue 4 years ago • 1 comments
trafficstars

In %err-disp-common in l1-error-signal.lisp L90

                 (simple-file-error (make-condition condition-name
                                             :pathname (car errargs)
                                             :error-type format-string
                                             :format-arguments (cdr errargs)))

but:

(define-condition simple-file-error (simple-condition file-error)
  ()
  (:report (lambda (c s)
	     (apply #'format s (slot-value c 'error-type) 
		    (file-error-pathname c)
		    (simple-condition-format-arguments c)))))

and:

(define-condition simple-condition (condition)
  ((format-control :initarg :format-control
                  :reader simple-condition-format-control)
   (format-arguments :initarg :format-arguments
                     :initform nil
                     :reader simple-condition-format-arguments))
  (:report (lambda (c stream)  ;; If this were a method, slot value might be faster someday.  Accessors always faster ?
                               ;; And of course it's terribly important that this be as fast as humanly possible...
	    ;Use accessors because they're documented and users can specialize them.
            (apply #'format stream (simple-condition-format-control c)
                   (simple-condition-format-arguments c)))))

simple-file-error is a simple-condition that has a format-control slot, but this slot is not filled by %err-disp-common, therefore handlers that try to use that slot to format the error fail.

Note that %err-disp-common has a format-string argument that is correctly filled; I'd suggest adding a line:

                                                      :format-control format-string

to the make-condition call.

informatimago avatar Apr 29 '21 03:04 informatimago

Proposed patch:

[pjb@despina org.xquartz:0 ccl-git 37Gi]$ git diff -t -w -b
diff --git a/level-1/l1-error-signal.lisp b/level-1/l1-error-signal.lisp
index 18b2cd78..35c373e7 100644
--- a/level-1/l1-error-signal.lisp
+++ b/level-1/l1-error-signal.lisp
@@ -87,6 +87,7 @@
                    (simple-file-error (make-condition condition-name
                                                       :pathname (car errargs)
                                                       :error-type format-string
+                                                      :format-control format-string
                                                       :format-arguments (cdr errargs)))
                    (undefined-function (make-condition condition-name
                                                        :name (car errargs)))

[pjb@despina org.xquartz:0 ccl-git 37Gi]$ 

informatimago avatar Apr 29 '21 03:04 informatimago