HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge from emacs-24; up to 2012-12-11T09:51:12Z!dmantipov@yandex.ru
[bpt/emacs.git]
/
lisp
/
emacs-lisp
/
testcover.el
diff --git
a/lisp/emacs-lisp/testcover.el
b/lisp/emacs-lisp/testcover.el
index
97a37c0
..
f6bd26e
100644
(file)
--- a/
lisp/emacs-lisp/testcover.el
+++ b/
lisp/emacs-lisp/testcover.el
@@
-1,6
+1,6
@@
;;;; testcover.el -- Visual code-coverage tool
;;;; testcover.el -- Visual code-coverage tool
-;; Copyright (C) 2002
, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
+;; Copyright (C) 2002
-2013
Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@@
-28,7
+28,7
@@
;; * Use `testcover-mark-all' to add overlay "splotches" to the Lisp file's
;; buffer to show where coverage is lacking. Normally, a red splotch
;; indicates the form was never evaluated; a brown splotch means it always
;; * Use `testcover-mark-all' to add overlay "splotches" to the Lisp file's
;; buffer to show where coverage is lacking. Normally, a red splotch
;; indicates the form was never evaluated; a brown splotch means it always
-;; evaluted to the same value.
+;; evalu
a
ted to the same value.
;; * Use `testcover-next-mark' (bind it to a key!) to jump to the next spot
;; that has a splotch.
;; * Use `testcover-next-mark' (bind it to a key!) to jump to the next spot
;; that has a splotch.
@@
-220,7
+220,7
@@
non-nil, byte-compiles each function after instrumenting."
(defun testcover-reinstrument (form)
"Reinstruments FORM to use testcover instead of edebug. This
function modifies the list that FORM points to. Result is nil if
(defun testcover-reinstrument (form)
"Reinstruments FORM to use testcover instead of edebug. This
function modifies the list that FORM points to. Result is nil if
-FORM should return multiple vlues, t if should always return same
+FORM should return multiple v
a
lues, t if should always return same
value, 'maybe if either is acceptable."
(let ((fun (car-safe form))
id val)
value, 'maybe if either is acceptable."
(let ((fun (car-safe form))
id val)
@@
-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)))
(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))
(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
,(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))))))
(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
,(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))))))
(let ((testcover-noreturn-functions
(cons id testcover-noreturn-functions)))
(testcover-reinstrument (cadr form))))))
@@
-430,7
+430,7
@@
FUN should be `testcover-reinstrument' for compositional functions,
"Turn off instrumentation of all macros and functions in FILENAME."
(interactive "fStop covering file: ")
(let ((buf (find-file-noselect filename)))
"Turn off instrumentation of all macros and functions in FILENAME."
(interactive "fStop covering file: ")
(let ((buf (find-file-noselect filename)))
- (eval-buffer buf
t
)))
+ (eval-buffer buf)))
;;;=========================================================================
;;;=========================================================================
@@
-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."
(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))
(cond
((eq (aref testcover-vector idx) 'unknown)
(aset testcover-vector idx val))
@@
-509,7
+515,7
@@
eliminated by adding more test cases."
(set-buffer-modified-p changed))))
(defun testcover-mark-all (&optional buffer)
(set-buffer-modified-p changed))))
(defun testcover-mark-all (&optional buffer)
- "Mark all forms in BUFFER that did not get complet
le
y tested during
+ "Mark all forms in BUFFER that did not get complet
el
y tested during
coverage tests. This function creates many overlays."
(interactive "bMark forms in buffer: ")
(if buffer
coverage tests. This function creates many overlays."
(interactive "bMark forms in buffer: ")
(if buffer
@@
-534,5
+540,4
@@
coverage tests. This function creates many overlays."
(goto-char (next-overlay-change (point)))
(end-of-line))
(goto-char (next-overlay-change (point)))
(end-of-line))
-;; arch-tag: 72324a4a-4a2e-4142-9249-cc56d6757588
;; testcover.el ends here.
;; testcover.el ends here.