home *** CD-ROM | disk | FTP | other *** search
- ;;; tst-analyze.el -- analyze test results
- ;;; Copyright (c) 1987 Wang Institute of Graduate Studies
-
- ;;; Tony Bolt
-
- (require 'tst-annotate)
- (provide 'tst-analyze)
-
- (defun tst-analyze ()
- "Driver for test analysis functions.
- Invokes tst-anl-zero-counts and tst-anl-constant-values"
- (interactive)
- (message "Analyze test results (counts) ...")
- (tst-anl-zero-counts)
- (message "Analyze test results (values) ...")
- (tst-anl-constant-values)
- (message "Analyze test results (values) ... done") t)
-
- (defun tst-anl-zero-counts ()
- "Examines the test results stored in the annotation database looking
- for lines with a zero count value, i.e. those that were not executed"
- (let ((lines (tst-ann-get-lines)))
- (cond ((null lines) nil)
- (t (mapcar 'tst-anl-zero-count lines)))))
-
- (defconst tst-anl-zero-count 'NEVER->>
- "* The value used by the display package to indicate a zero count value")
-
- (defun tst-anl-zero-count (line)
- "Given a LINE id, retrieves the value of that line's count field from
- the annotation database. If the value is zero, stores a new attribute,
- called zero, with value a string for use by the display package.
- Otherwise remove attribute zero."
- (let ((count (car (tst-ann-get line 'count))))
- (cond ((equal count 0)
- (tst-ann-put line 'zero (list tst-anl-zero-count)))
- (t (tst-ann-remove-attribute line 'zero)))))
-
- (defun tst-anl-constant-values ()
- "Examines the test results stored in the annotation database looking
- for lines which returned a constant count value every time they were
- executed"
- (let ((lines (tst-ann-get-lines)))
- (cond ((null lines) nil)
- (t (mapcar 'tst-anl-constant-value lines)))))
-
- (defun tst-anl-constant-value (line)
- "Given a LINE id, retrieves the values field and examines the list to
- determine if all the values are equal. If they are equal, stores a
- new attribute, called constant, with the value of one of those elements.
-
- If the list contains a single element then it is considered to be constant"
-
- (let ((values (tst-ann-get line 'values)))
- (while (and (not (null (cdr values)))
- (equal (car values) (car (cdr values))))
- (setq values (cdr values)))
- (if (= 1 (length values))
- (tst-ann-put line 'constant values)
- ;; else
- (tst-ann-remove-attribute line 'constant))))
-
-