diff options
| author | Daniel Colascione <dancol@dancol.org> | 2012-10-07 14:31:58 -0800 |
|---|---|---|
| committer | Daniel Colascione <dancol@dancol.org> | 2012-10-07 14:31:58 -0800 |
| commit | 36a305a723c63fd345be65c536c52fe9765c14be (patch) | |
| tree | fb89d9e103552863214c60297a65320917109357 /lisp/emacs-lisp/testcover.el | |
| parent | 2ab329f3b5d52a39f0a45c3d9c129f1c19560142 (diff) | |
| parent | 795b1482a9e314cda32d62ac2988f573d359366e (diff) | |
| download | emacs-36a305a723c63fd345be65c536c52fe9765c14be.tar.gz | |
Merge from trunk
Diffstat (limited to 'lisp/emacs-lisp/testcover.el')
| -rw-r--r-- | lisp/emacs-lisp/testcover.el | 24 |
1 files changed, 15 insertions, 9 deletions
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)) |