home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume11 / test.el / part02 / tst-analyze.el < prev    next >
Lisp/Scheme  |  1987-09-08  |  2KB  |  63 lines
  1. ;;; tst-analyze.el -- analyze test results
  2. ;;; Copyright (c) 1987 Wang Institute of Graduate Studies
  3.  
  4. ;;; Tony Bolt
  5.  
  6. (require 'tst-annotate)
  7. (provide 'tst-analyze)
  8.  
  9. (defun tst-analyze ()
  10.   "Driver for test analysis functions.
  11.    Invokes tst-anl-zero-counts and tst-anl-constant-values"
  12.   (interactive)
  13.   (message "Analyze test results (counts) ...")
  14.   (tst-anl-zero-counts)
  15.   (message "Analyze test results (values) ...")
  16.   (tst-anl-constant-values)
  17.   (message "Analyze test results (values) ... done") t)
  18.   
  19. (defun tst-anl-zero-counts ()
  20.   "Examines the test results stored in the annotation database looking
  21.    for lines with a zero count value, i.e. those that were not executed"
  22.   (let ((lines (tst-ann-get-lines)))
  23.     (cond ((null lines) nil)
  24.       (t (mapcar 'tst-anl-zero-count lines)))))
  25.  
  26. (defconst tst-anl-zero-count 'NEVER->>
  27.   "* The value used by the display package to indicate a zero count value")
  28.  
  29. (defun tst-anl-zero-count (line)
  30.   "Given a LINE id, retrieves the value of that line's count field from
  31.    the annotation database.  If the value is zero, stores a new attribute, 
  32.    called zero, with value a string for use by the display package.
  33.    Otherwise remove attribute zero."
  34.   (let ((count (car (tst-ann-get line 'count))))
  35.     (cond ((equal count 0)
  36.        (tst-ann-put line 'zero (list tst-anl-zero-count)))
  37.       (t (tst-ann-remove-attribute line 'zero)))))
  38.  
  39. (defun tst-anl-constant-values ()
  40.   "Examines the test results stored in the annotation database looking
  41.    for lines which returned a constant count value every time they were
  42.    executed"
  43.   (let ((lines (tst-ann-get-lines)))
  44.     (cond ((null lines) nil)
  45.           (t (mapcar 'tst-anl-constant-value lines)))))
  46.  
  47. (defun tst-anl-constant-value (line)
  48.   "Given a LINE id, retrieves the values field and examines the list to
  49.    determine if all the values are equal.  If they are equal, stores a 
  50.    new attribute, called constant, with the value of one of those elements.
  51.  
  52.   If the list contains a single element then it is considered to be constant"
  53.  
  54.   (let ((values (tst-ann-get line 'values)))
  55.     (while (and (not (null (cdr values)))
  56.         (equal (car values) (car (cdr values))))
  57.       (setq values (cdr values)))
  58.     (if (= 1 (length values))
  59.     (tst-ann-put line 'constant  values)
  60.       ;; else
  61.       (tst-ann-remove-attribute line 'constant))))
  62.  
  63.