summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2011-02-17 23:44:39 -0800
committerPaul Eggert <eggert@cs.ucla.edu>2011-02-17 23:44:39 -0800
commit37b3d30244ad822e049b6b20c2eadf5946cb02cc (patch)
tree49bfe5e475aee761975f2618be4ee1b7c8371a72 /lisp/emacs-lisp
parent0ca2f89e09202a02f392c1defba2105b69c01419 (diff)
parent7d315eb67800796d7d7f39030eb7682340d985e5 (diff)
downloademacs-37b3d30244ad822e049b6b20c2eadf5946cb02cc.tar.gz
emacs-37b3d30244ad822e049b6b20c2eadf5946cb02cc.tar.bz2
emacs-37b3d30244ad822e049b6b20c2eadf5946cb02cc.zip
Merge from mainline.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/ert.el22
-rw-r--r--lisp/emacs-lisp/pcase.el9
2 files changed, 19 insertions, 12 deletions
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 695dc1e2db6..b3c95fcc78f 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1877,6 +1877,7 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
(let ((inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
+ (ert-results-mode)
;; Erase buffer again in case switching out of the previous
;; mode inserted anything. (This happens e.g. when switching
;; from ert-results-mode to ert-results-mode when
@@ -1895,9 +1896,8 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
(ewoc-enter-last ewoc
(make-ert--ewoc-entry :test test :hidden-p t)))
(ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
- (goto-char (1- (point-max)))))
- (ert-results-mode)
- buffer)))
+ (goto-char (1- (point-max)))
+ buffer)))))
(defvar ert--selector-history nil
@@ -2343,6 +2343,7 @@ To be used in the ERT results buffer."
(let ((inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
+ (ert-simple-view-mode)
;; Use unibyte because `debugger-setup-buffer' also does so.
(set-buffer-multibyte nil)
(setq truncate-lines t)
@@ -2351,8 +2352,7 @@ To be used in the ERT results buffer."
(goto-char (point-min))
(insert "Backtrace for test `")
(ert-insert-test-name-button (ert-test-name test))
- (insert "':\n")
- (ert-simple-view-mode)))))))
+ (insert "':\n")))))))
(defun ert-results-pop-to-messages-for-test-at-point ()
"Display the part of the *Messages* buffer generated during the test at point.
@@ -2368,12 +2368,12 @@ To be used in the ERT results buffer."
(let ((inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
+ (ert-simple-view-mode)
(insert (ert-test-result-messages result))
(goto-char (point-min))
(insert "Messages for test `")
(ert-insert-test-name-button (ert-test-name test))
- (insert "':\n")
- (ert-simple-view-mode)))))
+ (insert "':\n")))))
(defun ert-results-pop-to-should-forms-for-test-at-point ()
"Display the list of `should' forms executed during the test at point.
@@ -2389,6 +2389,7 @@ To be used in the ERT results buffer."
(let ((inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
+ (ert-simple-view-mode)
(if (null (ert-test-result-should-forms result))
(insert "\n(No should forms during this test.)\n")
(loop for form-description in (ert-test-result-should-forms result)
@@ -2406,8 +2407,7 @@ To be used in the ERT results buffer."
(insert (concat "(Values are shallow copies and may have "
"looked different during the test if they\n"
"have been modified destructively.)\n"))
- (forward-line 1)
- (ert-simple-view-mode)))))
+ (forward-line 1)))))
(defun ert-results-toggle-printer-limits-for-test-at-point ()
"Toggle how much of the condition to print for the test at point.
@@ -2442,6 +2442,7 @@ To be used in the ERT results buffer."
(let ((inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
+ (ert-simple-view-mode)
(if (null data)
(insert "(No data)\n")
(insert (format "%-3s %8s %8s\n" "" "time" "cumul"))
@@ -2454,8 +2455,7 @@ To be used in the ERT results buffer."
(insert "\n"))))
(goto-char (point-min))
(insert "Tests by run time (seconds):\n\n")
- (forward-line 1)
- (ert-simple-view-mode))))
+ (forward-line 1))))
;;;###autoload
(defun ert-describe-test (test-or-test-name)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 24ea0a3e801..3179672a3ec 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -61,6 +61,8 @@ UPatterns can take the following forms:
`QPAT matches if the QPattern QPAT matches.
(pred PRED) matches if PRED applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
+If a SYMBOL is used twice in the same pattern (i.e. the pattern is
+\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
QPatterns can take the following forms:
(QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
@@ -457,7 +459,12 @@ and otherwise defers to REST which is a list of branches of the form
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
((symbolp upat)
- (pcase--u1 matches code (cons (cons upat sym) vars) rest))
+ (if (not (assq upat vars))
+ (pcase--u1 matches code (cons (cons upat sym) vars) rest)
+ ;; Non-linear pattern. Turn it into an `eq' test.
+ (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars)))))
+ matches)
+ code vars rest)))
((eq (car-safe upat) '\`)
(pcase--q1 sym (cadr upat) matches code vars rest))
((eq (car-safe upat) 'or)