[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/testcover.el

[Jonathan Yavner]

Index: emacs/lisp/emacs-lisp/testcover.el
diff -c emacs/lisp/emacs-lisp/testcover.el:1.5 
emacs/lisp/emacs-lisp/testcover.el:1.6
*** emacs/lisp/emacs-lisp/testcover.el:1.5      Mon Sep  1 11:45:22 2003
--- emacs/lisp/emacs-lisp/testcover.el  Sun Nov 30 01:56:28 2003
***************
*** 171,184 ****
  ;;; Add instrumentation to your module
  ;;;=========================================================================
  
- ;;;###autoload
  (defun testcover-start (filename &optional byte-compile)
    "Uses edebug to instrument all macros and functions in FILENAME, then
  changes the instrumentation from edebug to testcover--much faster, no
  problems with type-ahead or post-command-hook, etc.  If BYTE-COMPILE is
  non-nil, byte-compiles each function after instrumenting."
    (interactive "f")
!   (let ((buf             (find-file filename))
        (load-read-function 'testcover-read)
        (edebug-all-defs t))
      (setq edebug-form-data                       nil
--- 171,183 ----
  ;;; Add instrumentation to your module
  ;;;=========================================================================
  
  (defun testcover-start (filename &optional byte-compile)
    "Uses edebug to instrument all macros and functions in FILENAME, then
  changes the instrumentation from edebug to testcover--much faster, no
  problems with type-ahead or post-command-hook, etc.  If BYTE-COMPILE is
  non-nil, byte-compiles each function after instrumenting."
    (interactive "f")
!   (let ((buf                (find-file filename))
        (load-read-function 'testcover-read)
        (edebug-all-defs t))
      (setq edebug-form-data                       nil
***************
*** 210,216 ****
    "Reinstruments FORM to use testcover instead of edebug.  This function
  modifies the list that FORM points to.  Result is non-nil if FORM will
  always return the same value."
!   (let ((fun (car-safe form)))
      (cond
       ((not fun) ;Atom
        (or (not (symbolp form))
--- 209,216 ----
    "Reinstruments FORM to use testcover instead of edebug.  This function
  modifies the list that FORM points to.  Result is non-nil if FORM will
  always return the same value."
!   (let ((fun (car-safe form))
!       id)
      (cond
       ((not fun) ;Atom
        (or (not (symbolp form))
***************
*** 234,243 ****
        (testcover-reinstrument (cadr form)))
       ((memq fun testcover-compose-functions)
        ;;1-valued if all arguments are
!       (setq fun t)
!       (mapc #'(lambda (x) (setq fun (or (testcover-reinstrument x) fun)))
            (cdr form))
!       fun)
       ((eq fun 'edebug-enter)
        ;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
        ;;  => (testcover-enter 'SYM #'(lambda nil FORMS))
--- 234,243 ----
        (testcover-reinstrument (cadr form)))
       ((memq fun testcover-compose-functions)
        ;;1-valued if all arguments are
!       (setq id t)
!       (mapc #'(lambda (x) (setq id (or (testcover-reinstrument x) id)))
            (cdr form))
!       id)
       ((eq fun 'edebug-enter)
        ;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
        ;;  => (testcover-enter 'SYM #'(lambda nil FORMS))
***************
*** 250,266 ****
        ;; => (testcover-after YYY FORM), mark XXX as ok-coverage
        (unless (eq (cadr form) 0)
        (aset testcover-vector (cadr (cadr form)) 'ok-coverage))
!       (setq fun (nth 2 form))
        (setcdr form (nthcdr 2 form))
!       (if (not (memq (car-safe (nth 2 form)) testcover-noreturn-functions))
!         (setcar form 'testcover-after)
        ;;This function won't return, so set the value in advance
        ;;(edebug-after (edebug-before XXX) YYY FORM)
        ;;  => (progn (edebug-after YYY nil) FORM)
        (setcar form 'progn)
!       (setcar (cdr form) `(testcover-after ,fun nil)))
        (when (testcover-reinstrument (nth 2 form))
!       (aset testcover-vector fun '1value)))
       ((eq fun 'defun)
        (if (testcover-reinstrument-list (nthcdr 3 form))
          (push (cadr form) testcover-module-1value-functions)))
--- 250,271 ----
        ;; => (testcover-after YYY FORM), mark XXX as ok-coverage
        (unless (eq (cadr form) 0)
        (aset testcover-vector (cadr (cadr form)) 'ok-coverage))
!       (setq id (nth 2 form))
        (setcdr form (nthcdr 2 form))
!       (cond
!        ((memq (car-safe (nth 2 form)) testcover-noreturn-functions)
        ;;This function won't return, so set the value in advance
        ;;(edebug-after (edebug-before XXX) YYY FORM)
        ;;  => (progn (edebug-after YYY nil) FORM)
        (setcar form 'progn)
!       (setcar (cdr form) `(testcover-after ,id nil)))
!        ((eq (car-safe (nth 2 form)) '1value)
!       ;;This function is always supposed to return the same value
!       (setcar form 'testcover-1value))
!        (t
!       (setcar form 'testcover-after)))
        (when (testcover-reinstrument (nth 2 form))
!       (aset testcover-vector id '1value)))
       ((eq fun 'defun)
        (if (testcover-reinstrument-list (nthcdr 3 form))
          (push (cadr form) testcover-module-1value-functions)))
***************
*** 316,323 ****
        ;;Hack - pretend the arg is 1-valued here
        (if (symbolp (cadr form)) ;A pseudoconstant variable
          t
        (let ((testcover-1value-functions
!              (cons (car (cadr form)) testcover-1value-functions)))
          (testcover-reinstrument (cadr form)))))
       (t ;Some other function or weird thing
        (testcover-reinstrument-list (cdr form))
--- 321,331 ----
        ;;Hack - pretend the arg is 1-valued here
        (if (symbolp (cadr form)) ;A pseudoconstant variable
          t
+       (if (eq (car (cadr form)) 'edebug-after)
+           (setq id (car (nth 3 (cadr form))))
+         (setq id (car (cadr form))))
        (let ((testcover-1value-functions
!              (cons id testcover-1value-functions)))
          (testcover-reinstrument (cadr form)))))
       (t ;Some other function or weird thing
        (testcover-reinstrument-list (cdr form))
***************
*** 348,362 ****
    (let ((buf (find-file-noselect buffer)))
      (eval-buffer buf t)))
  
- (defmacro 1value (form)
-   "For coverage testing, indicate FORM should always have the same value."
-   form)
- 
- (defmacro noreturn (form)
-   "For coverage testing, indicate that FORM will never return."
-   `(prog1 ,form
-      (error "Form marked with `noreturn' did return")))
- 
  
  ;;;=========================================================================
  ;;; Accumulate coverage data
--- 356,361 ----
***************
*** 379,384 ****
--- 378,396 ----
      (aset testcover-vector idx 'ok-coverage)))
    val)
  
+ (defun testcover-1value (idx val)
+   "Internal function for coverage testing.  Returns VAL after installing it in
+ `testcover-vector' at offset IDX.  Error if FORM does not always return the
+ same value during coverage testing."
+   (cond
+    ((eq (aref testcover-vector idx) '1value)
+     (aset testcover-vector idx (cons '1value val)))
+    ((not (and (eq (car-safe (aref testcover-vector idx)) '1value)
+             (equal (cdr (aref testcover-vector idx)) val)))
+     (error "Value of form marked with `1value' does vary.")))
+   val)
+ 
+ 
  
  ;;;=========================================================================
  ;;; Display the coverage data as color splotches on your code.
***************
*** 411,416 ****
--- 423,429 ----
        (setq len  (1- len)
              data (aref coverage len))
        (when (and (not (eq data 'ok-coverage))
+                  (not (eq (car-safe data) '1value))
                   (setq j (+ def-mark (aref points len))))
          (setq ov (make-overlay (1- j) j))
          (overlay-put ov 'face