[Emacs-diffs] /srv/bzr/emacs/trunk r110204: * lisp/emacs-lisp/testcover.el (testcover-after): Add gv-expander.

[Stefan Monnier]

------------------------------------------------------------
revno: 110204
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2012-09-26 10:41:05 -0400
message:
  * lisp/emacs-lisp/testcover.el (testcover-after): Add gv-expander.
  (testcover-reinstrument): Simplify with CSE.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/gv.el
  lisp/emacs-lisp/testcover.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-09-26 14:11:18 +0000
+++ b/lisp/ChangeLog    2012-09-26 14:41:05 +0000
@@ -1,3 +1,8 @@
+2012-09-26  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/testcover.el (testcover-after): Add gv-expander.
+       (testcover-reinstrument): Simplify with CSE.
+
 2012-09-26  Juanma Barranquero  <address@hidden>
 
        * 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  <address@hidden>
 
@@ -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  <address@hidden>
 
-       * 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  <address@hidden>
 

=== modified file 'lisp/emacs-lisp/gv.el'
--- a/lisp/emacs-lisp/gv.el     2012-09-24 12:31:24 +0000
+++ b/lisp/emacs-lisp/gv.el     2012-09-26 14:41:05 +0000
@@ -269,7 +269,7 @@
 ;;;###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)

=== modified file 'lisp/emacs-lisp/testcover.el'
--- a/lisp/emacs-lisp/testcover.el      2012-01-19 07:21:25 +0000
+++ b/lisp/emacs-lisp/testcover.el      2012-09-26 14:41:05 +0000
@@ -270,9 +270,9 @@
       (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 @@
                                              ,(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 @@
                                   ,(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 @@
 (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))