aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--modules/system-defaults.el29
-rw-r--r--tests/test-system-defaults-functions.el31
2 files changed, 53 insertions, 7 deletions
diff --git a/modules/system-defaults.el b/modules/system-defaults.el
index 7f369a5e..9b4652e8 100644
--- a/modules/system-defaults.el
+++ b/modules/system-defaults.el
@@ -55,6 +55,10 @@
(expand-file-name "comp-warnings.log" user-emacs-directory)
"File where native-comp warnings will be appended.")
+(defvar cj/comp-warnings-log-max-bytes (* 512 1024)
+ "Cap on `comp-warnings-log' size. Once it exceeds this, the log is reset
+before the next write, so native-comp warnings can't grow it without bound.")
+
(defun cj/log-comp-warning (type message &rest args)
"Log native-comp warnings of TYPE with MESSAGE & ARGS.
Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the
@@ -62,13 +66,24 @@ Log to buffer `comp-warnings-log'. Suppress warnings from appearing in the
timestamp to the file specified by `comp-warnings-log'. Return non-nil to
indicate the warning was handled."
(when (memq 'comp (if (listp type) type (list type)))
- (with-temp-buffer
- (insert (format-time-string "[%Y-%m-%d %H:%M:%S] "))
- (insert (if (stringp message)
- (apply #'format message args)
- (format "%S %S" message args)))
- (insert "\n")
- (append-to-file (point-min) (point-max) comp-warnings-log))
+ ;; Reset the log if it has grown past the cap, so async comp warnings can't
+ ;; grow it without bound.
+ (when (ignore-errors
+ (> (or (file-attribute-size (file-attributes comp-warnings-log)) 0)
+ cj/comp-warnings-log-max-bytes))
+ (ignore-errors (delete-file comp-warnings-log)))
+ ;; Guard the write: this runs as `:before-until' advice on `display-warning',
+ ;; so a signal here (an unwritable log path) would propagate out and break
+ ;; warning display for every async comp notice. Swallow the failure; the
+ ;; warning stays suppressed either way.
+ (ignore-errors
+ (with-temp-buffer
+ (insert (format-time-string "[%Y-%m-%d %H:%M:%S] "))
+ (insert (if (stringp message)
+ (apply #'format message args)
+ (format "%S %S" message args)))
+ (insert "\n")
+ (append-to-file (point-min) (point-max) comp-warnings-log)))
;; Return non-nil to tell `display-warning' “we handled it.”
t))
diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el
index c603fc7e..4b647166 100644
--- a/tests/test-system-defaults-functions.el
+++ b/tests/test-system-defaults-functions.el
@@ -162,5 +162,36 @@ and the rendered S-expression lands in the log."
(should (string-match-p ":slot" contents)))))
(delete-file comp-warnings-log))))
+(ert-deftest test-system-defaults-log-comp-warning-unwritable-log-does-not-signal ()
+ "Error: an unwritable log path must not signal.
+The function is `:before-until' advice on `display-warning'; a signal here
+propagates out of `display-warning' and breaks warning display for every
+async native-comp notice. It swallows the write failure and still returns
+t (the warning stays suppressed), rather than crashing."
+ (let ((comp-warnings-log "/proc/nonexistent-dir/cannot-write.log"))
+ (should (eq t (cj/log-comp-warning 'comp "boom")))))
+
+(ert-deftest test-system-defaults-log-comp-warning-caps-log-growth ()
+ "Boundary: the log is bounded — once it exceeds the cap, a further write
+resets it (deletes the old file, keeping only the new entry) rather than
+growing without limit. A hard reset, not a tail-trim: on overflow the old
+history is discarded, which is fine for a transient diagnostic log."
+ (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log")))
+ (unwind-protect
+ (progn
+ ;; Seed the file well over the cap.
+ (with-temp-file comp-warnings-log
+ (insert (make-string (1+ cj/comp-warnings-log-max-bytes) ?x)))
+ (should (> (file-attribute-size (file-attributes comp-warnings-log))
+ cj/comp-warnings-log-max-bytes))
+ (cj/log-comp-warning 'comp "after the cap")
+ (should (<= (file-attribute-size (file-attributes comp-warnings-log))
+ cj/comp-warnings-log-max-bytes))
+ ;; The newest entry survives the trim.
+ (with-temp-buffer
+ (insert-file-contents comp-warnings-log)
+ (should (string-match-p "after the cap" (buffer-string)))))
+ (delete-file comp-warnings-log))))
+
(provide 'test-system-defaults-functions)
;;; test-system-defaults-functions.el ends here