commit c3684b97885c5a1f4d0713ff45c7395e9a4c6e8a (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Thu Mar 28 19:57:22 2024 +0800 ; * java/org/gnu/emacs/EmacsActivity.java (isReallyFinishing): Fix typo. diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index f5b05a9c184..e380b7bfc2a 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -297,7 +297,7 @@ children and RESETWHENCHILDLESS is set (implying it is a long atime, dtime; int hours; - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.NOUGAT) + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) return isFinishing (); /* When the number of tasks retained in the recents list exceeds a commit 755665d95adbba07335f400f1090e53b66c41ff5 Author: Po Lu Date: Thu Mar 28 19:56:31 2024 +0800 Prevent Android OS task trimming from deleting Emacs frames * doc/emacs/android.texi (Android Windowing): Document proviso on Android 7.0 and later. * java/org/gnu/emacs/EmacsActivity.java (EmacsActivity) : New field. (onStop, onResume): Set and clear timeOfLastInteraction. (isReallyFinishing): New function. (onDestroy): Don't delete frame even in the event isFinishing returns true if more than 4 hours have elapsed since the activity last moved into the background. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index b367515cb35..01732961998 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -858,6 +858,18 @@ When the user closes the window created during application startup, and the window was not previously closed by the system in order to save resources, Emacs deletes any frame displayed within that window. +However, on Android 7.0 and later, such frames are not deleted if the +window is closed four or more hours after the window moves into the +background, as the system automatically removes open windows once a +certain period of inactivity elapses when the number of windows retained +by the window manager surpasses a specific threshold, and window +deletion by this mechanism is indistinguishable from window deletion by +the user. Emacs begins to ignore window deletion after two hours less +than the default value of this threshold both to err on the side of +caution, in case the system's record of inactivity and Emacs's differ, +and for the reason that this threshold is open to customization by OS +distributors. + @item When the user or the system closes any window created by Emacs on behalf of a specific frame, Emacs deletes the frame displayed within diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 6ab6a709bef..f5b05a9c184 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -20,9 +20,12 @@ package org.gnu.emacs; import java.lang.IllegalStateException; + import java.util.List; import java.util.ArrayList; +import java.util.concurrent.TimeUnit; + import android.app.Activity; import android.content.ContentResolver; @@ -31,6 +34,7 @@ import android.os.Build; import android.os.Bundle; +import android.os.SystemClock; import android.util.Log; @@ -78,6 +82,9 @@ public class EmacsActivity extends Activity /* The last context menu to be closed. */ private static Menu lastClosedMenu; + /* The time of the most recent call to onStop. */ + private static long timeOfLastInteraction; + static { focusedActivities = new ArrayList (); @@ -271,6 +278,50 @@ children and RESETWHENCHILDLESS is set (implying it is a syncFullscreenWith (window); } + @Override + public final void + onStop () + { + timeOfLastInteraction = SystemClock.elapsedRealtime (); + + super.onStop (); + } + + /* Return whether the task is being finished in response to explicit + user action. That is to say, Activity.isFinished, but as + documented. */ + + public final boolean + isReallyFinishing () + { + long atime, dtime; + int hours; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.NOUGAT) + return isFinishing (); + + /* When the number of tasks retained in the recents list exceeds a + threshold, Android 7 and later so destroy activities in trimming + them from recents on the expiry of a timeout that isFinishing + returns true, in direct contradiction to the documentation. This + timeout is generally 6 hours, but admits of customization by + individual system distributors, so to err on the side of the + caution, the timeout Emacs applies is a more conservative figure + of 4 hours. */ + + if (timeOfLastInteraction == 0) + return isFinishing (); + + atime = timeOfLastInteraction; + + /* Compare atime with the current system time. */ + dtime = SystemClock.elapsedRealtime () - atime; + if (dtime + 1000000 < TimeUnit.HOURS.toMillis (4)) + return isFinishing (); + + return false; + } + @Override public final void onDestroy () @@ -283,7 +334,8 @@ children and RESETWHENCHILDLESS is set (implying it is a /* The activity will die shortly hereafter. If there is a window attached, close it now. */ isMultitask = this instanceof EmacsMultitaskActivity; - manager.removeWindowConsumer (this, isMultitask || isFinishing ()); + manager.removeWindowConsumer (this, (isMultitask + || isReallyFinishing ())); focusedActivities.remove (this); invalidateFocus (2); @@ -340,6 +392,7 @@ children and RESETWHENCHILDLESS is set (implying it is a onResume () { isPaused = false; + timeOfLastInteraction = 0; EmacsWindowAttachmentManager.MANAGER.noticeDeiconified (this); super.onResume (); commit 4cee95815b9d7d56f6f77abb1cc17e346c038685 Author: Stefan Monnier Date: Thu Mar 28 15:31:04 2024 -0400 pp.el: Try and fix bug#70039 * lisp/emacs-lisp/pp.el (pp-fill): Avoid splitting `#N#` or `#[`. * test/lisp/emacs-lisp/pp-tests.el (pp-tests--sanity): New test. diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 26c77d6b047..d586fc59939 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -166,12 +166,19 @@ it inserts and pretty-prints that arg at point." (interactive "r") (if (null end) (pp--object beg #'pp-fill) (goto-char beg) - (let ((end (copy-marker end t)) - (newline (lambda () - (skip-chars-forward ")]}") - (unless (save-excursion (skip-chars-forward " \t") (eolp)) - (insert "\n") - (indent-according-to-mode))))) + (let* ((end (copy-marker end t)) + (avoid-unbreakable + (lambda () + (and (memq (char-before) '(?# ?s ?f)) + (memq (char-after) '(?\[ ?\()) + (looking-back "#[sf]?" (- (point) 2)) + (goto-char (match-beginning 0))))) + (newline (lambda () + (skip-chars-forward ")]}") + (unless (save-excursion (skip-chars-forward " \t") (eolp)) + (funcall avoid-unbreakable) + (insert "\n") + (indent-according-to-mode))))) (while (progn (forward-comment (point-max)) (< (point) end)) (let ((beg (point)) @@ -198,10 +205,10 @@ it inserts and pretty-prints that arg at point." ;; reduce the indentation depth. ;; Similarly, we prefer to cut before a "." than after ;; it because it reduces the indentation depth. - (while (not (zerop (skip-chars-backward " \t({[',."))) - (and (memq (char-before) '(?# ?s ?f)) - (looking-back "#[sf]?" (- (point) 2)) - (goto-char (match-beginning 0)))) + (while + (progn + (funcall avoid-unbreakable) + (not (zerop (skip-chars-backward " \t({[',."))))) (if (bolp) ;; The sexp already starts on its own line. (progn (goto-char beg) nil) diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index 7f7c798cde8..7606183d645 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -66,4 +66,23 @@ (while (search-forward "." nil t) (should (not (eolp)))))) +(ert-deftest pp-tests--sanity () + (with-temp-buffer + (lisp-data-mode) + (let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))")) + (let ((res (car (read-from-string testdata)))) + (dotimes (i (length testdata)) + (erase-buffer) + (insert testdata) + (let ((fill-column i)) + (pp-fill (point-min) (point-max)) + (goto-char (point-min)) + (condition-case err + (should (equal (read (current-buffer)) res)) + (invalid-read-syntax + (message "Invalid fill result with i=%d:\n%s" + i (buffer-string)) + (signal (car err) (cdr err)) + )))))))) + ;;; pp-tests.el ends here. commit de9e913f9e2a1e01e5d091a553e98d75404a2246 Author: Stefan Monnier Date: Thu Mar 28 12:27:54 2024 -0400 * lisp/emacs-lisp/cl-macs.el (list): Predefine predicate by hand diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 051cd992fc1..a84ef4a34b2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3470,6 +3470,10 @@ Of course, we really can't know that for sure, so it's just a heuristic." (keyword . keywordp) ;Would need `keyword-with-pos`. (natnum . natnump) ;Subtype of fixnum & bignum. (real . numberp) ;Not clear where it would fit. + ;; This one is redundant, but we keep it to silence a + ;; warning during the early bootstrap when `cl-seq.el' gets + ;; loaded before `cl-preloaded.el' is defined. + (list . listp) )) (put type 'cl-deftype-satisfies pred)) commit 6c1a11078b194ed536db17381aad9e159e486fee Author: Eli Zaretskii Date: Thu Mar 28 12:15:13 2024 +0200 Fix a typo in flymake.el * lisp/progmodes/flymake.el (flymake--update-eol-overlays): Use 'save-restriction', not 'save-excursion'. (Bug#69984) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index db00cc59c0e..779c612f479 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -744,7 +744,7 @@ associated `flymake-category' return DEFAULT." (defun flymake--update-eol-overlays () "Update the `before-string' property of end-of-line overlays." - (save-excursion + (save-restriction (widen) (dolist (o (overlays-in (point-min) (point-max))) (when (overlay-get o 'flymake--eol-overlay) commit a4da3971f2580c90fb3c6957eea2d0dbfb695879 Author: Joseph Turner Date: Sat Mar 23 13:29:17 2024 -0700 copy-tree just image map, not entire image * lisp/image.el (image--compute-original-map): Copy only the image map. (Bug#69602) diff --git a/lisp/image.el b/lisp/image.el index 55340ea03dc..d7496485aca 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1455,24 +1455,23 @@ When :rotation is not a multiple of 90, return copy of :original-map." If IMAGE lacks :map property, return nil. When :rotation is not a multiple of 90, return copy of :map." (when (image-property image :map) - (let* ((image-copy (copy-tree image t)) - (map (image-property image-copy :map)) - (scale (or (image-property image-copy :scale) 1)) - (rotation (or (image-property image-copy :rotation) 0)) - (flip (image-property image-copy :flip)) - (size (image-size image-copy t))) + (let* ((original-map (copy-tree (image-property image :map) t)) + (scale (or (image-property image :scale) 1)) + (rotation (or (image-property image :rotation) 0)) + (flip (image-property image :flip)) + (size (image-size image t))) (when (and ; Handle only 90-degree rotations (zerop (mod rotation 1)) (zerop (% (truncate rotation) 90))) ;; In rendered images, rotation is always applied before flip. - ;; To undo the transformation, flip before rotating. - ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP. - ;; Therefore, scale MAP after flip and rotate operations, since - ;; both need MAP to fit SIZE. - (image--flip-map map flip size) - (image--rotate-map map (- rotation) size) - (image--scale-map map (/ 1.0 scale))) - map))) + ;; To undo the transformation, flip before rotating. SIZE fits + ;; ORIGINAL-MAP before transformations are applied. Therefore, + ;; scale ORIGINAL-MAP after flip and rotate operations, since + ;; both need ORIGINAL-MAP to fit SIZE. + (image--flip-map original-map flip size) + (image--rotate-map original-map (- rotation) size) + (image--scale-map original-map (/ 1.0 scale))) + original-map))) (defun image--scale-map (map scale) "Scale MAP according to SCALE. commit f021c3dbcd08eb1b0e3215ba6fd4e56364e6915f Author: Eli Zaretskii Date: Thu Mar 28 11:50:22 2024 +0200 ; * etc/NEWS: Announce new feature of Proced. (Bug#69784) diff --git a/etc/NEWS b/etc/NEWS index 25c4efa590f..696d744e342 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1430,6 +1430,14 @@ When this is non-nil, the lines of key sequences are displayed with the most recent line first. This is can be useful when working with macros with many lines, such as from 'kmacro-edit-lossage'. +** Proced + +--- +*** More control on automatic update of Proced buffers. +The user option 'proced-auto-update-flag' can now be set to 2 additional +values, which control automatic updates of Proced buffers that are not +displayed in some window. + ** Miscellaneous --- commit b2793febcaa31bf21caff2d6461fd328f0892ad2 Author: Rahguzar Date: Fri Mar 15 18:46:46 2024 +0100 Allow for auto updating only visible proced buffers (bug#69784) * lisp/proced.el (proced-auto-update-flag): Document 'visible' value and add it to the custom type. (proced-auto-update-timer, proced-toggle-auto-update): Take 'visible' value into account. diff --git a/lisp/proced.el b/lisp/proced.el index 7d7de1e2ce3..1d257b6bd4d 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -362,9 +362,13 @@ of `proced-grammar-alist'." :type 'integer) (defcustom proced-auto-update-flag nil - "Non-nil for auto update of a Proced buffer. -Can be changed interactively via `proced-toggle-auto-update'." - :type 'boolean) + "Non-nil means auto update proced buffers. +Special value `visible' means only update proced buffers that are currently +displayed in a window. Can be changed interactively via +`proced-toggle-auto-update'." + :type '(radio (const :tag "Don't auto update" nil) + (const :tag "Only update visible proced buffers" visible) + (const :tag "Update all proced buffers" t))) (make-variable-buffer-local 'proced-auto-update-flag) (defcustom proced-tree-flag nil @@ -951,28 +955,40 @@ Proced buffers." "Auto-update Proced buffers using `run-at-time'. If there are no proced buffers, cancel the timer." - (unless (seq-filter (lambda (buf) - (with-current-buffer buf - (when (eq major-mode 'proced-mode) - (if proced-auto-update-flag - (proced-update t t)) - t))) - (buffer-list)) + (if-let (buffers (match-buffers '(derived-mode . proced-mode))) + (dolist (buf buffers) + (when-let ((flag (buffer-local-value 'proced-auto-update-flag buf)) + ((or (not (eq flag 'visible)) + (get-buffer-window buf 'visible)))) + (with-current-buffer buf + (proced-update t t)))) (cancel-timer proced-auto-update-timer) (setq proced-auto-update-timer nil))) (defun proced-toggle-auto-update (arg) "Change whether this Proced buffer is updated automatically. With prefix ARG, update this buffer automatically if ARG is positive, -otherwise do not update. Sets the variable `proced-auto-update-flag'. -The time interval for updates is specified via `proced-auto-update-interval'." +update the buffer only when the buffer is displayed in a window if ARG is 0, +otherwise do not update. Sets the variable `proced-auto-update-flag' by +cycling between nil, `visible' and t. The time interval for updates is +specified via `proced-auto-update-interval'." (interactive (list (or current-prefix-arg 'toggle)) proced-mode) (setq proced-auto-update-flag - (cond ((eq arg 'toggle) (not proced-auto-update-flag)) - (arg (> (prefix-numeric-value arg) 0)) + (cond ((eq arg 'toggle) + (cond ((not proced-auto-update-flag) 'visible) + ((eq proced-auto-update-flag 'visible) t) + (t nil))) + (arg + (setq arg (prefix-numeric-value arg)) + (message "%s" arg) + (cond ((> arg 0) t) + ((eq arg 0) 'visible) + (t nil))) (t (not proced-auto-update-flag)))) (message "Proced auto update %s" - (if proced-auto-update-flag "enabled" "disabled"))) + (cond ((eq proced-auto-update-flag 'visible) "enabled (only when buffer is visible)") + (proced-auto-update-flag "enabled (unconditionally)") + (t "disabled")))) ;;; Mark commit cdd7093e17a33a6efc4721af461af180e5af602d Author: Vladimir Kazanov Date: Tue Mar 12 11:14:54 2024 +0000 Improve ert-font-lock assertion parser (Bug#69714) Fail on files with no assertions, parser now accepts multiple carets per line and face lists: * lisp/emacs-lisp/ert-font-lock.el: Assertion parser fix. * test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js: * test/lisp/emacs-lisp/ert-font-lock-tests.el (test-parse-comments--no-assertion-error) (test-syntax-highlight-inline--caret-negated-wrong-face) (test-macro-test--file-no-asserts): New test cases. * doc/misc/ert.texi (Syntax Highlighting Tests): More syntax examples. diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index bd2ad495142..8767de71496 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -951,11 +951,13 @@ that assigns face properties to parts of the buffer. The @code{ert-font-lock} package makes it possible to introduce unit tests checking face assignment. Test assertions are included in code-level comments directly and can be read either from inline strings or files. +The parser expects the input string to contain at least one assertion. Test assertion parser extracts tests from comment-only lines. Every -comment assertion line starts either with a caret (@samp{^}) or an -arrow (@samp{<-}). A caret/arrow should be followed immediately by the -name of a face to be checked. +comment assertion line starts either with a caret (@samp{^}) or an arrow +(@samp{<-}). A single caret/arrow or carets should be followed +immediately by the name of a face or a list of faces to be checked +against the @code{:face} property at point. The test then checks if the first non-assertion column above the caret contains a face expected by the assertion: @@ -967,10 +969,43 @@ var variable = 11; // ^ font-lock-punctuation-face // this is not an assertion, it's just a comment // ^ font-lock-comment-face + +// multiple carets per line +// ^^^^ ^ ^ font-lock-comment-face +@end example + +Both symbol-only @code{:face} property values and assertion face values +are normalized to single element lists so assertions below are +equivalent: + +@example +// single +// ^ font-lock-comment-face +// single +// ^ (font-lock-comment-face) +@end example + +Assertions can be negated: + +@example +var variable = 11; +// ^ !font-lock-comment-face +@end example + +It is possible to specify face lists in assertions: + +@example +// TODO +// ^^^^ (font-lock-comment-face hl-todo) + var test = 1; +// ^ () +// ^ nil +// negation works as expected +// ^ !nil @end example -The arrow means that the first non-empty column of the assertion line -will be used for the check: +The arrow (@samp{<-}) means that the first non-empty column of the +assertion line will be used for the check: @example var variable = 1; diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el index 29114712f92..e77c8945dc3 100644 --- a/lisp/emacs-lisp/ert-font-lock.el +++ b/lisp/emacs-lisp/ert-font-lock.el @@ -39,16 +39,33 @@ (require 'newcomment) (require 'pcase) -(defconst ert-font-lock--assertion-re +(defconst ert-font-lock--face-symbol-re + (rx (one-or-more (or alphanumeric "-" "_" "."))) + "A face symbol matching regex.") + +(defconst ert-font-lock--face-symbol-list-re + (rx "(" + (* whitespace) + (one-or-more + (seq (regexp ert-font-lock--face-symbol-re) + (* whitespace))) + ")") + "A face symbol list matching regex.") + +(defconst ert-font-lock--assertion-line-re (rx - ;; column specifiers + ;; leading column assertion (arrow/caret) (group (or "^" "<-")) - (one-or-more " ") + (zero-or-more whitespace) + ;; possible to have many carets on an assertion line + (group (zero-or-more (seq "^" (zero-or-more whitespace)))) ;; optional negation of the face specification (group (optional "!")) - ;; face symbol name - (group (one-or-more (or alphanumeric "-" "_" ".")))) - "An ert-font-lock assertion regex.") + (zero-or-more whitespace) + ;; face symbol name or a list of symbols + (group (or (regexp ert-font-lock--face-symbol-re) + (regexp ert-font-lock--face-symbol-list-re)))) + "An ert-font-lock assertion line regex.") (defun ert-font-lock--validate-major-mode (mode) "Validate if MODE is a valid major mode." @@ -212,7 +229,7 @@ be used through `ert'. (save-excursion (beginning-of-line) (skip-syntax-forward " ") - (re-search-forward ert-font-lock--assertion-re + (re-search-forward ert-font-lock--assertion-line-re (line-end-position) t 1))) (defun ert-font-lock--goto-first-char () @@ -252,8 +269,8 @@ be used through `ert'. (throw 'nextline t)) - ;; Collect the assertion - (when (re-search-forward ert-font-lock--assertion-re + ;; Collect the first line assertion (caret or arrow) + (when (re-search-forward ert-font-lock--assertion-line-re (line-end-position) t 1) (unless (> linetocheck -1) @@ -266,21 +283,38 @@ be used through `ert'. (- (match-beginning 1) (line-beginning-position)) (ert-font-lock--get-first-char-column))) ;; negate the face? - (negation (string-equal (match-string-no-properties 2) "!")) + (negation (string-equal (match-string-no-properties 3) "!")) ;; the face that is supposed to be in the position specified - (face (match-string-no-properties 3))) + (face (read (match-string-no-properties 4)))) + ;; Collect the first assertion on the line (push (list :line-checked linetocheck :line-assert curline :column-checked column-checked :face face :negation negation) - tests)))) + tests) + + ;; Collect all the other line carets (if present) + (goto-char (match-beginning 2)) + (while (equal (following-char) ?^) + (setq column-checked (- (point) (line-beginning-position))) + (push (list :line-checked linetocheck + :line-assert curline + :column-checked column-checked + :face face + :negation negation) + tests) + (forward-char) + (skip-syntax-forward " "))))) ;; next line (setq curline (1+ curline)) (forward-line 1)) + (unless tests + (user-error "No test assertions found")) + (reverse tests))) (defun ert-font-lock--point-at-line-and-column (line column) @@ -307,21 +341,30 @@ The function is meant to be run from within an ERT test." (let* ((line-checked (plist-get test :line-checked)) (line-assert (plist-get test :line-assert)) (column-checked (plist-get test :column-checked)) - (expected-face (intern (plist-get test :face))) + (expected-face (plist-get test :face)) (negation (plist-get test :negation)) (actual-face (get-text-property (ert-font-lock--point-at-line-and-column line-checked column-checked) 'face)) (line-str (ert-font-lock--get-line line-checked)) (line-assert-str (ert-font-lock--get-line line-assert))) - (when (not (eq actual-face expected-face)) + ;; normalize both expected and resulting face - these can be + ;; either symbols, nils or lists of symbols + (when (not (listp actual-face)) + (setq actual-face (list actual-face))) + (when (not (listp expected-face)) + (setq expected-face (list expected-face))) + + ;; fail when lists are not 'equal and the assertion is *not negated* + (when (and (not negation) (not (equal actual-face expected-face))) (ert-fail (list (format "Expected face %S, got %S on line %d column %d" expected-face actual-face line-checked column-checked) :line line-str :assert line-assert-str))) - (when (and negation (eq actual-face expected-face)) + ;; fail when lists are 'equal and the assertion is *negated* + (when (and negation (equal actual-face expected-face)) (ert-fail (list (format "Did not expect face %S face on line %d, column %d" actual-face line-checked column-checked) diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js new file mode 100644 index 00000000000..5eae9af212f --- /dev/null +++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js @@ -0,0 +1,2 @@ +var abc = function(d) { +}; diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el index e0ba1e949b2..fa2e5dc4db7 100644 --- a/test/lisp/emacs-lisp/ert-font-lock-tests.el +++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el @@ -138,13 +138,24 @@ print(\"Hello, world!\")" (forward-line) (should (ert-font-lock--line-comment-p)))) +(ert-deftest test-parse-comments--no-assertion-error () + (let* ((str " +not_an_assertion +random_symbol +")) + (with-temp-buffer + (insert str) + (javascript-mode) + + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) + (ert-deftest test-parse-comments--single-line-error () (let* ((str "// ^ face.face1")) (with-temp-buffer (insert str) (javascript-mode) - (should-error (ert-font-lock--parse-comments))))) + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) (ert-deftest test-parse-comments--single-line-single-caret () (let* ((str " @@ -159,7 +170,46 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)))))) + +(ert-deftest test-parse-comments--single-line-many-carets () + (let* ((str " +multiplecarets +//^^^ ^^ ^ face.face1 +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 6)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil))))))) + +(ert-deftest test-parse-comments--face-list () + (let* ((str " +facelist +// ^ (face1 face2) +// ^ !(face3 face4) +// ^ (face5) +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 3)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t) + (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil))))))) (ert-deftest test-parse-comments--caret-negation () (let* ((str " @@ -175,11 +225,11 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t) - (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t) + (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil))))))) -(ert-deftest test-parse-comments--single-line-multiple-carets () +(ert-deftest test-parse-comments--single-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -196,12 +246,12 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 4)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil) - (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil) + (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil))))))) -(ert-deftest test-parse-comments--multiple-line-multiple-carets () +(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -218,9 +268,9 @@ third (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 4 :line-assert 5 :column-checked 3 :face "face2" :negation nil) - (:line-checked 4 :line-assert 6 :column-checked 5 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 4 :line-assert 5 :column-checked 3 :face face2 :negation nil) + (:line-checked 4 :line-assert 6 :column-checked 5 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--arrow-single-line-single () @@ -236,7 +286,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)))))) (ert-deftest test-parse-comments-arrow-multiple-line-single () @@ -254,9 +304,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--non-assert-comment-single () (let* ((str " @@ -271,7 +321,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--non-assert-comment-multiple () (let* ((str " @@ -288,9 +338,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil))))))) (ert-deftest test-parse-comments--multiline-comment-single () @@ -308,7 +358,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)))))) + '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--multiline-comment-multiple () (let* ((str " @@ -327,13 +377,47 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil) - (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil))))))) + '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil) + (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil))))))) ;;; Syntax highlighting assertion tests ;; -(ert-deftest test-syntax-highlight-inline--caret-multiple-faces () +(ert-deftest test-syntax-highlight-inline--nil-list () + (let ((str " +var abc = function(d) { +// ^ nil +// ^ !nil +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--face-list () + (let ((str " +var abc = function(d) { +// ^ (test-face-2 test-face-1 font-lock-variable-name-face) +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (add-face-text-property (point-min) (point-max) 'test-face-1) + (add-face-text-property (point-min) (point-max) 'test-face-2) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions () (let ((str " var abc = function(d) { // ^ font-lock-variable-name-face @@ -364,6 +448,19 @@ var abc = function(d) { (should-error (ert-font-lock--check-faces (ert-font-lock--parse-comments)))))) +(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face () + (let* ((str " +var abc = function(d) { +// ^ !not-a-face +}; +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) (ert-deftest test-syntax-highlight-inline--comment-face () (let* ((str " @@ -455,6 +552,12 @@ var abc = function(d) { javascript-mode "correct.js") +(ert-font-lock-deftest-file test-macro-test--file-no-asserts + "Check failing on files without assertions" + :expected-result :failed + javascript-mode + "no-asserts.js") + (ert-font-lock-deftest-file test-macro-test--file-failing "Test reading wrong assertions from a file" :expected-result :failed commit 35ae2c576b8570da7b2e791991ad852c648be896 Author: Eli Zaretskii Date: Thu Mar 28 11:34:25 2024 +0200 ; * lisp/emacs-lisp/pcase.el (pcase--subtype-bitsets): Doc fix. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e2d0c0dc068..23f1bac600c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -688,8 +688,9 @@ recording whether the var has been referenced by earlier parts of the match." ;; start compiling code, and hence baking the result into files). (with-eval-after-load 'cl-preloaded (defconst pcase--subtype-bitsets (pcase--subtype-bitsets))))) - "Table mapping predicates to their set of types. -These are the set of built-in types for which they may return non-nil. + "Hash table mapping type predicates to their sets of types. +The table maps each type predicate, such as `numberp' and `stringp', +to the set of built-in types for which the predicate may return non-nil. The sets are represented as bitsets (integers) where each bit represents a specific leaf type. Which bit represents which type is unspecified.")