Function to display test coverage

For the Compleat Fan
Locked
neil456
Posts: 12
Joined: Tue Feb 03, 2015 5:32 pm
Location: Kansas City, MO

Function to display test coverage

Post by neil456 »

I found this function valuable in determining that the existing Postgres module test code did not cover very many of the functions. It would be handy to have this someplace in the core. It probably needs to be cleaned up. But here it is, for you to use as you see fit. Permission is given to use for any purpose, without restriction.

Code: Select all

;;
;; @syntax (checkTestCoverage <function-testFunction> <context-testCode> <bool-showPassing>)
;; @param <function-testFunction> The function that tests the code.
;; @param <context-testCode> The context that contains the code to be tested.
;; @param <bool-showPassing> Flag to indicate printing of calls in the test function along with count of the number of times called.
;; @return 'float' as the percent of unique calls in the test function, given the functions defined in the context.
;; Functions in the context that are never called from the test function are always printed.
;; Functions in the context that are called from the test function may or may not be printed depending on the flag.
;;
;; This function assumes that the test function is in the 'MAIN' context and that each
;; relevant call in the test function is prefixed with the context name.
;;
;; To test the PgSQL module:
;; '  (println (format {Percent PgSQL Coverage: %3.1f} (checkTestCoverage 'test-pgsql PgSQL)))'
;;
;; Neil Tiffin, March 2015, newLisp 10.6.2

(define (checkTestCoverage testFunction testContext showTestCount)
  (let (
    (test-functions nil) 
    (context-functions (sort  (filter (fn (s) (lambda? (eval s))) (symbols testContext)))))
    (dolist (ln (parse (source testFunction) "\n"))
      (let (found-list (find-all (append (string testContext) {:[^"'\(\):,\s]+}) ln))
        (if (true? found-list)
          (dolist (found-function found-list)
              (if (nil? test-functions)
                (push (list found-function 1) test-functions)
                (if (nil? (assoc found-function test-functions)) 
                  (push (list found-function 1) test-functions)
                  (setf (assoc found-function test-functions) (list found-function (+ 1 (lookup found-function test-functions 1))))))))))

    (dolist (symb context-functions)
      (if (nil? (assoc (string symb) test-functions))
        (println "Function NOT Tested: " symb)))

    (if (true? showTestCount)
      (dolist (symb context-functions)
        (if (true? (assoc (string symb) test-functions))
          (println "Function     Tested: " (format {%3d  } (lookup (string symb) test-functions 1)) symb ))))

    ; return percent coverage   
    (mul (div (float (length test-functions)) (float (length context-functions))) 100.0)))

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Re: Function to display test coverage

Post by Lutz »

Neil also added to the current postgres.lsp module, now available here: http://www.newlisp.org/code/modules/postgres.lsp.html as part of the standard modules.

Locked