mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-09 07:40:39 -08:00
Code Issues Projects Releases Wiki Activity

Rename the `1value' symbol in testcover.el

Browse source 
* lisp/emacs-lisp/testcover.el: Rename the symbol `1value'
throughout the file to `testcover-1value' to allow using the
variable in code that's to be tested (bug#25471).
This commit is contained in:
Lars Ingebrigtsen 2021-02-06 12:28:46 +01:00
parent 2476abc1f2
commit cf0869d22b
1 changed files with 30 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

60
lisp/emacs-lisp/testcover.el
View file

@ -258,10 +258,10 @@ vector. Return VALUE."
(aset testcover-vector after-index (testcover--copy-object value)))
((eq 'maybe old-result)
(aset testcover-vector after-index 'edebug-ok-coverage))
((eq '1value old-result)
((eq 'testcover-1value old-result)
(aset testcover-vector after-index
(cons old-result (testcover--copy-object value))))
((and (eq (car-safe old-result) '1value)
((and (eq (car-safe old-result) 'testcover-1value)
(not (condition-case ()
(equal (cdr old-result) value)
(circular-list t))))
@ -358,11 +358,11 @@ eliminated by adding more test cases."
data (aref coverage len))
(when (and (not (eq data 'edebug-ok-coverage))
(not (memq (car-safe data)
'(1value maybe noreturn)))
'(testcover-1value maybe noreturn)))
(setq j (+ def-mark (aref points len))))
(setq ov (make-overlay (1- j) j))
(overlay-put ov 'face
(if (memq data '(edebug-unknown maybe 1value))
(if (memq data '(edebug-unknown maybe testcover-1value))
'testcover-nohits
'testcover-1value))))
(set-buffer-modified-p changed))))
@ -450,12 +450,12 @@ or return multiple values."
(`(defconst ,sym . ,args)
(push sym testcover-module-constants)
(testcover-analyze-coverage-progn args)
'1value)
'testcover-1value)
(`(defun ,name ,_ . ,doc-and-body)
(let ((val (testcover-analyze-coverage-progn doc-and-body)))
(cl-case val
((1value) (push name testcover-module-1value-functions))
((testcover-1value) (push name testcover-module-1value-functions))
((maybe) (push name testcover-module-potentially-1value-functions)))
nil))
@ -466,13 +466,13 @@ or return multiple values."
;; To avoid infinite recursion, don't examine quoted objects.
;; This will cause the coverage marks on an instrumented quoted
;; form to look odd. See bug#25316.
'1value)
'testcover-1value)
(`(\` ,bq-form)
(testcover-analyze-coverage-backquote-form bq-form))
((or 't 'nil (pred keywordp))
'1value)
'testcover-1value)
((pred vectorp)
(testcover-analyze-coverage-compose (append form nil)
@ -482,7 +482,7 @@ or return multiple values."
nil)
((pred atom)
'1value)
'testcover-1value)
(_
;; Whatever we have here, it's not wrapped, so treat it as a list of forms.
@ -494,7 +494,7 @@ Analyze all the forms in FORMS and return 1value, maybe or nil
depending on the analysis of the last one. Find the coverage
vectors referenced by `edebug-enter' forms nested within FORMS and
update them with the results of the analysis."
(let ((result '1value))
(let ((result 'testcover-1value))
(while (consp forms)
(setq result (testcover-analyze-coverage (pop forms))))
result))
@ -516,9 +516,9 @@ form to be treated accordingly."
(aset testcover-vector before-id 'edebug-ok-coverage))
(setq val (testcover-analyze-coverage-wrapped-form wrapped-form))
(when (or (eq wrapper '1value) val)
(when (or (eq wrapper 'testcover-1value) val)
;; The form is 1-valued or potentially 1-valued.
(aset testcover-vector after-id (or val '1value)))
(aset testcover-vector after-id (or val 'testcover-1value)))
(cond
((or (eq wrapper 'noreturn)
@ -526,13 +526,13 @@ form to be treated accordingly."
;; This function won't return, so indicate to testcover-before that
;; it should record coverage.
(aset testcover-vector before-id (cons 'noreturn after-id))
(aset testcover-vector after-id '1value)
(setq val '1value))
(aset testcover-vector after-id 'testcover-1value)
(setq val 'testcover-1value))
((eq (car-safe wrapped-form) '1value)
((eq (car-safe wrapped-form) 'testcover-1value)
;; This function is always supposed to return the same value.
(setq val '1value)
(aset testcover-vector after-id '1value)))
(setq val 'testcover-1value)
(aset testcover-vector after-id 'testcover-1value)))
val))
(defun testcover-analyze-coverage-wrapped-form (form)
@ -540,26 +540,26 @@ form to be treated accordingly."
FORM is treated as if it will be evaluated."
(pcase form
((pred keywordp)
'1value)
'testcover-1value)
((pred symbolp)
(when (or (memq form testcover-constants)
(memq form testcover-module-constants))
'1value))
'testcover-1value))
((pred atom)
'1value)
'testcover-1value)
(`(\` ,bq-form)
(testcover-analyze-coverage-backquote-form bq-form))
(`(defconst ,sym ,val . ,_)
(push sym testcover-module-constants)
(testcover-analyze-coverage val)
'1value)
'testcover-1value)
(`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body)
;; These always return RESULT if provided.
(testcover-analyze-coverage expr)
(testcover-analyze-coverage-progn body)
(let ((val (testcover-analyze-coverage-progn result)))
;; If the third value is not present, the loop always returns nil.
(if result val '1value)))
(if result val 'testcover-1value)))
(`(,(or 'let 'let*) ,bindings . ,body)
(testcover-analyze-coverage-progn bindings)
(testcover-analyze-coverage-progn body))
@ -586,9 +586,9 @@ FORM is treated as if it will be evaluated."
;; depending on the symbol.
(let ((temp-form (cons func args)))
(testcover-analyze-coverage-wrapped-form temp-form)))
(`(,(and func (or '1value 'noreturn)) ,inner-form)
(`(,(and func (or 'testcover-1value 'noreturn)) ,inner-form)
;; 1value and noreturn change how the edebug-after they wrap is handled.
(let ((val (if (eq func '1value) '1value 'maybe)))
(let ((val (if (eq func 'testcover-1value) 'testcover-1value 'maybe)))
(pcase inner-form
(`(edebug-after ,(and before-form
(or `(edebug-before ,before-id) before-id))
@ -604,12 +604,12 @@ FORM is treated as if it will be evaluated."
(defun testcover-analyze-coverage-wrapped-application (func args)
"Analyze the application of FUNC to ARGS for code coverage."
(cond
((eq func 'quote) '1value)
((eq func 'quote) 'testcover-1value)
((or (memq func testcover-1value-functions)
(memq func testcover-module-1value-functions))
;; The function should always return the same value.
(testcover-analyze-coverage-progn args)
'1value)
'testcover-1value)
((or (memq func testcover-potentially-1value-functions)
(memq func testcover-module-potentially-1value-functions))
;; The function might always return the same value.
@ -635,14 +635,14 @@ If either argument is nil, return nil, otherwise if either
argument is maybe, return maybe. Return 1value only if both arguments
are 1value."
(cl-case val
(1value result)
(testcover-1value result)
(maybe (and result 'maybe))
(nil nil)))
(defun testcover-analyze-coverage-compose (forms func)
"Analyze a list of FORMS for code coverage using FUNC.
The list is 1valued if all of its constituent elements are also 1valued."
(let ((result '1value))
(let ((result 'testcover-1value))
(while (consp forms)
(setq result (testcover-coverage-combine result (funcall func (car forms))))
(setq forms (cdr forms)))
@ -652,7 +652,7 @@ The list is 1valued if all of its constituent elements are also 1valued."
(defun testcover-analyze-coverage-backquote (bq-list)
"Analyze BQ-LIST, the body of a backquoted list, for code coverage."
(let ((result '1value))
(let ((result 'testcover-1value))
(while (consp bq-list)
(let ((form (car bq-list))
val)
@ -670,7 +670,7 @@ The list is 1valued if all of its constituent elements are also 1valued."
"Analyze a single FORM from a backquoted list for code coverage."
(cond
((vectorp form) (testcover-analyze-coverage-backquote (append form nil)))
((atom form) '1value)
((atom form) 'testcover-1value)
((memq (car form) (list '\, '\,@))
(testcover-analyze-coverage (cadr form)))
(t (testcover-analyze-coverage-backquote form))))