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

(testcover-reinstrument): Simplify with CSE.
This commit is contained in:
Stefan Monnier 2012-09-26 10:41:05 -04:00
parent 42019c2e0c
commit 07b1a5fbc3
3 changed files with 36 additions and 25 deletions

View file

@ -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>

View file

@ -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)

View file

@ -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))