From 32e40fe970531962c4b12e9ff5ae6558995feb62 Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@consxy.com>
Date: Tue, 25 Jan 2022 06:22:27 -0600
Subject: [PATCH] Add test coverage check

---
 .candle                          | 23 ++++++++++++++++++++++-
 resources/dircheck/good.lisp     | 21 +++++++++++++++++++++
 resources/dircheck/longline.lisp |  3 +++
 resources/dircheck/package.lisp  |  7 +++++++
 resources/unmatchedending.lisp   |  3 +++
 src/main/wolf.lisp               |  6 ++----
 src/test/main.lisp               | 16 +++++++++++++++-
 7 files changed, 73 insertions(+), 6 deletions(-)
 create mode 100644 resources/dircheck/good.lisp
 create mode 100644 resources/dircheck/longline.lisp
 create mode 100644 resources/dircheck/package.lisp
 create mode 100644 resources/unmatchedending.lisp

diff --git a/.candle b/.candle
index ea94ec0..977edca 100644
--- a/.candle
+++ b/.candle
@@ -1,8 +1,29 @@
-(:packages :wolf :wolf-test :sheep)
+(:packages :wolf :wolf-test :sheep :sb-cover)
 (:name :wolf
  :tasks
  ((:name :test
    :directions (wolf-test:run-all-tests))
+  (:name :coverage :directions
+   (progn
+    (let
+     ((coverage nil)
+      (*error-output* (make-broadcast-stream))
+      (*standard-output* (make-broadcast-stream)))
+     (declaim (optimize sb-cover:store-coverage-data))
+     (asdf:load-system :wolf :force t)
+     (wolf-test:run-all-tests)
+     (setf coverage
+      (apply #'+
+       (mapcar
+        (lambda (coverage-item) (length (remove t (cdr coverage-item) :key #'cdr)))
+        (sb-cover:save-coverage))))
+     (declaim (optimize (sb-cover:store-coverage-data 0)))
+     (asdf:load-system :wolf :force t)
+     ; 39 here is the number of unexecuted forms/branches due to
+     ; error checking that can get triggered during mistakes in development,
+     ; but aren't accessible during normal running (because if they were,
+     ; that's be a bug we needed to fix!)
+     (= coverage 39))))
   (:name :wolf :directions
    (wolf:pretty-print-check-directory "src"
     :copyright-notice "; Copyright .* Frank Duncan \\(frank@consxy.com\\) under AGPL3.  See distributed LICENSE.txt."))
diff --git a/resources/dircheck/good.lisp b/resources/dircheck/good.lisp
new file mode 100644
index 0000000..10a6091
--- /dev/null
+++ b/resources/dircheck/good.lisp
@@ -0,0 +1,21 @@
+(in-package #:nothing)
+
+(defun small-guy (a b) (+ a b))
+(defun small-guy-2 (a b) (+ a b))
+
+; This comment is awesome
+(defun hello-world (a b c)
+ (progn
+  (let
+   ((x y)                            ; Ok, this comment is also great
+    (z 9))                           ; so is this one!
+   (with-open-file (str "increasinglylongfilenamesfailme.dat" :direction :input :if-does-not-exist :create)
+    (when
+     (read-line str)
+     (format t "This file had some things in int, yay!~%"))))))
+
+(defvar *x* "hello world
+ this is a multiline string
+ with \" some escaped things
+ and some (_) and whatnot
+ ")
diff --git a/resources/dircheck/longline.lisp b/resources/dircheck/longline.lisp
new file mode 100644
index 0000000..9ad1fbc
--- /dev/null
+++ b/resources/dircheck/longline.lisp
@@ -0,0 +1,3 @@
+(in-package #:nothing)
+
+(defun hello-world (a b c) (progn (with-open-file (str "increasinglylongfilenamesfailme.dat" :direction :input :if-does-not-exist :create) (when (read-line str) (format t "This file had some things in int, yay!~%")))))
diff --git a/resources/dircheck/package.lisp b/resources/dircheck/package.lisp
new file mode 100644
index 0000000..c3554d6
--- /dev/null
+++ b/resources/dircheck/package.lisp
@@ -0,0 +1,7 @@
+; Copyright XXXX AGPL
+(defpackage #:something (:use :common-lisp)
+ (:export :a :b :c))
+
+(defpackage #:nothing
+ (:use :common-lisp)
+ (:export :l))
diff --git a/resources/unmatchedending.lisp b/resources/unmatchedending.lisp
new file mode 100644
index 0000000..523e235
--- /dev/null
+++ b/resources/unmatchedending.lisp
@@ -0,0 +1,3 @@
+(in-package #:nothing)
+
+(list 'a 'b))
diff --git a/src/main/wolf.lisp b/src/main/wolf.lisp
index a5f6f69..0426111 100644
--- a/src/main/wolf.lisp
+++ b/src/main/wolf.lisp
@@ -13,9 +13,9 @@
 (defvar *state* nil)
 (defvar *line-no* nil)
 (defvar *col-no* nil)
-(defvar *evaluators* nil)
 (defvar *form-stack* nil)
 (defvar *form-ended-on-same-line* nil)
+(defparameter *evaluators* nil)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *possible-states*
@@ -57,9 +57,7 @@
 
 (defmacro defevaluator (state match func)
  (when (not (find state *possible-states*)) (error "~A is an invalid state" state))
- (let
-  ((scanner (gensym)))
-  `(pushnew (make-evaluator ,state ,match ,func) *evaluators*)))
+ `(pushnew (make-evaluator ,state ,match ,func) *evaluators*))
 
 (defun evaluate (text)
  (if (string= "" text)
diff --git a/src/test/main.lisp b/src/test/main.lisp
index 2512ea1..20991a5 100644
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -1,7 +1,7 @@
 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
 (in-package #:wolf-test)
 
-(defvar *tests* nil)
+(defparameter *tests* nil)
 
 (defmacro deftest (filename success &optional msg line-no col-no copyright-notice)
  `(push
@@ -59,3 +59,17 @@
 (deftest #P"resources/copyrightnotice.lisp" :success nil nil nil "; Copyright XXXX AGPL")
 (deftest #P"resources/copyrightnotice.lisp" :failure "Must begin with in-package form" 0 0)
 (deftest #P"resources/package.lisp" :failure "Must begin with specified copyright notice" 0 0 "; Copyright XXXX AGPL")
+(deftest #P"resources/unmatchedending.lisp" :failure "Unmatched ending paren" 2 12)
+
+; This is not a check for actually validity, but rather that the check directory code
+; checks the directory.
+(push
+ (lambda ()
+  (let
+   ((*standard-output* (make-broadcast-stream))
+    (*error-output* (make-broadcast-stream)))
+   (wolf:pretty-print-check-directory #P"resources/dircheck"
+    :copyright-notice "; Copyright XXXX AGPL")
+   (wolf:pretty-print-check-directory #P"resources/dircheck"))
+  t)
+ *tests*)
-- 
2.25.1