* lisp/emacs-lisp/testcover.el (testcover-after): Add gv-expander.

(testcover-reinstrument): Simplify with CSE.

3 files changed, 36 insertions, 25 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c69f8bc870b..4599855e28d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2012-09-26  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/testcover.el (testcover-after): Add gv-expander.
+        (testcover-reinstrument): Simplify with CSE.
+
 2012-09-26  Juanma Barranquero  <lekktu@gmail.com>
 
         * window.el (temp-buffer-window-setup): Fix typo in docstring.
@@ -13,9 +18,9 @@
         newline.  Reported by Andrew Jones.
         (verilog-auto-inst) Support expanding $clog2 in AUTOINST.
         Reported by Brad Dobbie.
-        (verilog-batch-delete-trailing-whitespace): Create
-        verilog-batch-delete-trailing-whitespace.  Reported by Brad
-        Dobbie.
+        (verilog-batch-delete-trailing-whitespace):
+        Create verilog-batch-delete-trailing-whitespace.
+        Reported by Brad Dobbie.
         (verilog-auto-inout-param): Support AUTOINOUTPARAM for copying
         parameters from another module.  Reported by Dan Katz.
         (verilog-auto, verilog-auto-assign-modport)
@@ -105,12 +110,12 @@
         * ansi-color.el (ansi-color-unfontify-region):
         * international/latin1-disp.el (latin1-char-displayable-p):
         * progmodes/cwarn.el (turn-on-cwarn-mode):
-        * progmodes/which-func.el (which-func-update-1): Use
-        define-obsolete-function-alias.
+        * progmodes/which-func.el (which-func-update-1):
+        Use define-obsolete-function-alias.
 
         * net/newst-backend.el (newsticker-cache-filename):
-        * net/newst-treeview.el (newsticker-groups-filename): Fix
-        incorrect obsolescence declaration.
+        * net/newst-treeview.el (newsticker-groups-filename):
+        Fix incorrect obsolescence declaration.
 
         * allout.el (allout-passphrase-hint-string): Likewise.
         (allout-init): Use a declare form to mark obsolete.
@@ -147,8 +152,8 @@
         Enhancements for triple-quote string syntax.
         * progmodes/python.el (python-quote-syntax): Remove.
         (python-syntax-propertize-function): New value.
-        (python-syntax-count-quotes, python-syntax-stringify): New
-        functions.
+        (python-syntax-count-quotes, python-syntax-stringify):
+        New functions.
 
 2012-09-24  Chong Yidong  <cyd@gnu.org>
 
@@ -181,8 +186,8 @@
         * vc/vc-hooks.el (vc-default-registered): Don't use
         vc-master-templates.
 
-        * font-lock.el (font-lock-reference-face): Use
-        define-obsolete-variable-alias.
+        * font-lock.el (font-lock-reference-face):
+        Use define-obsolete-variable-alias.
 
         * generic-x.el (rul-generic-mode): Use font-lock-constant-face.
         * calendar/calendar.el (calendar-font-lock-keywords):
@@ -213,8 +218,8 @@
 
 2012-09-23  Roland Winkler  <winkler@gnu.org>
 
-        * textmodes/bibtex.el (bibtex-autokey-transcriptions): Transcribe
-        also LaTeX hyphenation.
+        * textmodes/bibtex.el (bibtex-autokey-transcriptions):
+        Transcribe also LaTeX hyphenation.
         (bibtex-reformat): Bug fix. Do not quote twice the elements of
         bibtex-reformat-previous-options.
 
@@ -374,8 +379,8 @@
         (rst-section-tree, rst-section-tree-rec)
         (rst-section-tree-point): Refactor and document properly.
         (rst-imenu-find-adornments-for-position)
-        (rst-imenu-convert-cell, rst-imenu-create-index): New
-        function.
+        (rst-imenu-convert-cell, rst-imenu-create-index):
+        New function.
 
 2012-09-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 3541c99f5fe..7858c183e4b 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -269,7 +269,7 @@ The return value is the last VAL in the list.
 ;;;###autoload
 (put 'gv-place 'edebug-form-spec 'edebug-match-form)
 ;; CL did the equivalent of:
-;;(gv-define-expand edebug-after (lambda (before index place) place))
+;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
 
 (put 'edebug-after 'gv-expander
      (lambda (do before index place)
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 3999529f7ac..5fdc8c55a85 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -270,9 +270,9 @@ value, 'maybe if either is acceptable."
       (setq id (nth 2 form))
       (setcdr form (nthcdr 2 form))
       (setq val (testcover-reinstrument (nth 2 form)))
-      (if (eq val t)
-          (setcar form 'testcover-1value)
-        (setcar form 'testcover-after))
+      (setcar form (if (eq val t)
+                       'testcover-1value
+                     'testcover-after))
       (when val
         ;;1-valued or potentially 1-valued
         (aset testcover-vector id '1value))
@@ -359,9 +359,9 @@ value, 'maybe if either is acceptable."
                                               ,(nth 3 (cadr form))))
         t)
        (t
-        (if (eq (car (cadr form)) 'edebug-after)
-            (setq id (car (nth 3 (cadr form))))
-          (setq id (car (cadr form))))
+        (setq id (car (if (eq (car (cadr form)) 'edebug-after)
+                          (nth 3 (cadr form))
+                        (cadr form))))
         (let ((testcover-1value-functions
                (cons id testcover-1value-functions)))
           (testcover-reinstrument (cadr form))))))
@@ -379,9 +379,9 @@ value, 'maybe if either is acceptable."
                                    ,(nth 3 (cadr form))))
         'maybe)
        (t
-        (if (eq (car (cadr form)) 'edebug-after)
-            (setq id (car (nth 3 (cadr form))))
-          (setq id (car (cadr form))))
+        (setq id (car (if (eq (car (cadr form)) 'edebug-after)
+                          (nth 3 (cadr form))
+                        (cadr form))))
         (let ((testcover-noreturn-functions
                (cons id testcover-noreturn-functions)))
           (testcover-reinstrument (cadr form))))))
@@ -447,6 +447,12 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM
 (defun testcover-after (idx val)
   "Internal function for coverage testing.  Returns VAL after installing it in
 `testcover-vector' at offset IDX."
+  (declare (gv-expander (lambda (do)
+                          (gv-letplace (getter setter) val
+                            (funcall do getter
+                                     (lambda (store)
+                                       `(progn (testcover-after ,idx ,getter)
+                                               ,(funcall setter store))))))))
   (cond
    ((eq (aref testcover-vector idx) 'unknown)
     (aset testcover-vector idx val))