From 6c443e37a666be2246cf410847e6851601c16dbc Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Tue, 25 Jan 2022 08:42:41 -0600 Subject: [PATCH] Add coverage, get to near 100 --- .candle | 23 ++++- resources/success1.lisp | 25 ++++++ resources/success1.md | 24 ++++++ src/main/func.lisp | 7 +- src/main/var.lisp | 10 +-- src/test/failures.lisp | 187 ++++++++++++++++++++++++++++++++++++++++ src/test/main.lisp | 54 ++++++++++-- src/test/package.lisp | 3 + 8 files changed, 313 insertions(+), 20 deletions(-) diff --git a/.candle b/.candle index 5ba07cc..579c209 100644 --- a/.candle +++ b/.candle @@ -1,8 +1,29 @@ -(:packages :sheep :sheep-test :wolf) +(:packages :sheep :sheep-test :wolf :sb-cover) (:name :sheep :tasks ((:name :test :directions (sheep-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 :sheep :force t) + (sheep-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 :sheep :force t) + ; 34 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 34)))) (: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/success1.lisp b/resources/success1.lisp index 28d492d..642a326 100644 --- a/resources/success1.lisp +++ b/resources/success1.lisp @@ -6,7 +6,9 @@ This is should all get pulled in and the markdown.md should be equal to success1.md.") (:export #:*special-variable* + #:*special-variable-2* #:test-condition + #:test-struct #:func-that-does-stuff #:noargs #:no-args-and-values #:result-list #:has-no-examples #:values-result #:has-optional #:has-keywords #:has-rest)) @@ -30,16 +32,39 @@ DESCRIPTION: When true, it satisfies if coniditions. When NIL, it does not. That may make it seem like it's not very special, but it is. + But sometimes it needs to reference itself: *SPECIAL-VARIABLE* + EXAMPLES: (let ((*special-variable* t)) (go)) => 'let-it-go") +(defvar *special-variable-2* nil + "*SPECIAL-VARIABLE-2* + +VALUE TYPE: + + a generalized boolean + +INITIAL VALUE: + + NIL + +DESCRIPTION: + + It is special, and a boolean.") + (define-condition test-condition nil nil (:documentation "Simple documentation. For a simple condition.")) +(defstruct test-struct + "Simple documentation. + +For a simple structure. But this structure may go to two lines +for this part of it.") + (defun func-that-does-stuff (path x) "FUNC-THAT-DOES-STUFF PATH X => RESULT diff --git a/resources/success1.md b/resources/success1.md index 3c4b4f8..c8f6882 100644 --- a/resources/success1.md +++ b/resources/success1.md @@ -7,6 +7,7 @@ This is should all get pulled in and the markdown.md should be equal to success1 ## Contents * **variable [\*special\-variable\*](#variable-special-variable)** - It is special, and a boolean. +* **variable [\*special\-variable\-2\*](#variable-special-variable-2)** - It is special, and a boolean. * **function [func-that-does-stuff](#function-func-that-does-stuff)** - _func-that-does-stuff_ runs all the things against a file and returns as soon as the first func error is found. * **function [has-keywords](#function-has-keywords)** - _has-keywords_ runs all the things against a file and returns as soon as the first func error is found. * **function [has-no-examples](#function-has-no-examples)** - _has-no-examples_ runs all the things against a file and returns as soon as the first func error is found. @@ -16,6 +17,7 @@ This is should all get pulled in and the markdown.md should be equal to success1 * **function [noargs](#function-noargs)** - _noargs_ runs all the things against a file and returns as soon as the first func error is found. * **function [result-list](#function-result-list)** - _result-list_ runs all the things against a file and returns as soon as the first func error is found. * **condition [test-condition](#condition-test-condition)** - Simple documentation. +* **structure [test-struct](#struct-test-struct)** - Simple documentation. * **function [values-result](#function-values-result)** - _values-result_ runs all the things against a file and returns as soon as the first func error is found. ## Variable \*SPECIAL\-VARIABLE\* @@ -34,10 +36,26 @@ It is special, and a boolean. When true, it satisfies if coniditions. When NIL, it does not. That may make it seem like it's not very special, but it is. +But sometimes it needs to reference itself: _*special-variable*_ + #### Examples: ```(let ((*special-variable* t)) (go))``` => ```'let-it-go``` +## Variable \*SPECIAL\-VARIABLE\-2\* + +#### Value Type: + +a generalized boolean + +#### Initial Value: + +NIL + +#### Description: + +It is special, and a boolean. + ## Function **FUNC-THAT-DOES-STUFF** #### Syntax: @@ -214,6 +232,12 @@ Simple documentation. For a simple condition. +## Struct TEST-STRUCT + +Simple documentation. + +For a simple structure. But this structure may go to two lines for this part of it. + ## Function **VALUES-RESULT** #### Syntax: diff --git a/src/main/func.lisp b/src/main/func.lisp index ae5e25a..8f4b863 100644 --- a/src/main/func.lisp +++ b/src/main/func.lisp @@ -65,7 +65,8 @@ (fire-error (format nil "Type line did not match \" TYPE: type-definition\": ~A" type-line))) (cl-ppcre:register-groups-bind (type def) (type-scanner type-line) (let - ((decomposed-def (or (or-type def) (list-type def) (asterisk-type def) (symbol-type def)))) + ((decomposed-def (or (list-type def) (or-type def) (asterisk-type def) (symbol-type def)))) + ; This error should never be fired off, as the above regexes match everything (when (not decomposed-def) (fire-error (format nil "Couldn't figure out how to decompose: ~A" def))) (list type @@ -145,6 +146,7 @@ (process-examples)))) (defun parse-examples () + ; This error should never be fired off, as the only way description ends is if it ran into EXAMPLES (when (string/= "EXAMPLES:" (next)) (fire-error (format nil "Expected EXAMPLES: instead of: ~A" (prev-line)))) (expect-blank-line) (list :examples (process-examples))) @@ -220,8 +222,6 @@ (when (not (cl-ppcre:scan scanner (peek))) (fire-error (format nil "First line of ~A did not match: ~A {ARGS}* => {RESULT}*, ~A" func func-name (peek)))) (cl-ppcre:register-groups-bind (args result) (scanner (next)) - (when (cl-ppcre:scan "[a-z]" func-name) - (fire-error (format nil "Function name should be all uppercase: ~A" func-name))) (let ((ast-of-start (list @@ -273,6 +273,7 @@ (cond ((stringp text) text) ((and (listp text) (eql :keyword (car text))) (format nil "_~(~A~)_" (cadr text))) + ; This error should never get fired, as it would only if there were a bug in the conversion code (t (fire-error (format nil "Don't know how to convert text: ~S" text))))) (cadr text)))) diff --git a/src/main/var.lisp b/src/main/var.lisp index c184795..4238762 100644 --- a/src/main/var.lisp +++ b/src/main/var.lisp @@ -23,7 +23,6 @@ (defun verify-next-line (&key optional) (cond ((and optional (not (more))) t) - ((not (more)) (fire-error (format nil "Expected line after: ~A" (prev-line)))) ((cl-ppcre:scan " $" (peek)) (fire-error (format nil "Can't end line with a space: ~A" (peek)))) ((< 120 (length (peek))) (fire-error (format nil "Longer than 120 chars: ~A" (peek)))))) @@ -40,7 +39,7 @@ (cons (format nil "~A~A~A" (subseq next-line 2 (length next-line)) - (if (and (car rest-of-freeform) (string/= "" (car rest-of-freeform))) " " "") + (if (string/= "" (car rest-of-freeform)) " " "") (car rest-of-freeform)) (cdr rest-of-freeform)))) ((string= "" next-line) @@ -70,6 +69,7 @@ (process-examples)))) (defun parse-examples () + ; This shouldn't fire, unless there's a bug in our processing (when (string/= "EXAMPLES:" (next)) (fire-error (format nil "Expected EXAMPLES: instead of: ~A" (prev-line)))) (expect-blank-line) (list :examples (process-examples))) @@ -86,7 +86,6 @@ (lambda (text-item) (cond - ((not (stringp text-item)) (list text-item)) ((not (cl-ppcre:scan (cl-ppcre:quote-meta-chars (car remaining-keywords)) text-item)) (list text-item)) (t (let @@ -96,8 +95,6 @@ (mapcar (lambda (ti) (list (list :keyword (car remaining-keywords)) ti)) (cdr split-text))))))) (inject-keywords text (cdr remaining-keywords))))))) (list :text (inject-keywords text *keywords*)))) -; (map -; (list :text text)) (defun parse-header (var) (verify-next-line) @@ -105,8 +102,6 @@ ((var-name (symbol-name var))) (when (not (string= var-name (peek))) (fire-error (format nil "First line of ~A did not match: ~A, ~A" var var-name (peek)))) - (when (cl-ppcre:scan "[a-z]" var-name) - (fire-error (format nil "Variable name should be all uppercase: ~A" var-name))) (add-keyword var-name) (next) (expect-blank-line) @@ -134,6 +129,7 @@ (cond ((stringp text) text) ((and (listp text) (eql :keyword (car text))) (format nil "_~(~A~)_" (cadr text))) + ; This should never fire, unless there's a bug in our processor (t (fire-error (format nil "Don't know how to convert text: ~S" text))))) (cadr text)))) diff --git a/src/test/failures.lisp b/src/test/failures.lisp index 76f815d..87cfa58 100644 --- a/src/test/failures.lisp +++ b/src/test/failures.lisp @@ -339,6 +339,43 @@ DESCRIPTION: " "Expected ARGUMENTS AND VALUES: instead of: ARGUUMENTS AND VALUES:") +(deffailure-func-test + "Args-and-values - non empty next line" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + RESULT2: a thing + +DESCRIPTION: + +" + "No arguments left, but next line isn't empty: RESULT2: a thing") + +(deffailure-func-test + "Args-and-values - out of order arguments" + "UNUSED => RESULT1, RESULT2 + +ARGUMENTS AND VALUES: + + RESULT2: a thing + RESULT1: a thing + +DESCRIPTION: + +" + "Expected a description for RESULT1 but got one for RESULT2") + +(deffailure-func-test + "Args-and-values - ended before all arguments" + "UNUSED => RESULT1, RESULT2 + +ARGUMENTS AND VALUES: + + RESULT1: a thing" + "Expected line after: RESULT1: a thing") + (deffailure-func-test "Header - first line doesn't start with func-name (naturally all in upper case)" "UNUUSED => RESULT @@ -378,6 +415,56 @@ DESCRIPTION: " "Result in UNUSED should be all upper case: REsULT") +(deffailure-func-test + "Description - can't end line with space" + "UNUSED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a pathname + +DESCRIPTION: + + This is a test +" + "Can't end line with a space: This is a test ") + +(deffailure-func-test + "Symbols - keyword symbols must be all in lower case" + "UNUSED => RESULT + + RESULT: (:ASDF) + +DESCRIPTION: + + This is a test +" + "Keyword symbols must all be lower case: :ASDF") + +(deffailure-func-test + "Symbols - type symbols must be all in lower case" + "UNUSED => RESULT + + RESULT: (asdf) + +DESCRIPTION: + + This is a test +" + "Type symbols must all be upper case: asdf") + +(deffailure-func-test + "Symbols - list types can't have | in them" + "UNUSED => RESULT + + RESULT: (ASDF | FDSA) + +DESCRIPTION: + + This is a test +" + "List types can't have | in them: (ASDF | FDSA)") + (deffailure-var-test "Blank line - after value type" "*UNUSED* @@ -672,3 +759,103 @@ VALUE TYPE: a generalized boolean" "Got unexpected line, requires blank lines or start with two spaces: NIL") + +(deffailure-var-test + "General - Can't end line with a space" + "*UNUSED* + +VALUE TYPE: + + a generalized boolean + +INITIAL VALUE: + + NIL + +DESCRIPTION: + + This description line ends with a space " + "Can't end line with a space: This description line ends with a space ") + +(deffailure-var-test + "General - Longer than 120 characters" + (format nil "~A~A" + "*UNUSED* + +VALUE TYPE: + + a generalized boolean + +INITIAL VALUE: + + NIL + +DESCRIPTION: + + This description line ends with a space is very very long, so very long, really really long" + "it just keeps going and going and going and going and going and going") + (format nil "Longer than 120 chars: ~A~A" + "This description line ends with a space is very very long, so very long, really really long" + "it just keeps going and going and going and going and going and going")) + +(deffailure-pkg-test + "Line too long" + "Unused package with a first line that is extremely long, and how could it be so +long and it keeps going and going and going and going and going and going" + "First package paragraph is longer than 120 characters") + +(deffailure-pkg-test + "Line too long 2" + (format nil "~A~A" + "Unused package with a first line that is extremely long, and how could it be so" + "long and it keeps going and going and going and going and going and going") + (format nil "~A~A~A" + "Package description longer than 120 characters: " + "Unused package with a first line that is extremely long, and how could it be so" + "long and it keeps going and going and going and going and going and going")) + +(deffailure-pkg-test + "Two empty lines" + "Basic description + + +More information" + "Package description has two empty lines in it") + +(deffailure-pkg-test + "Started with space" + " Basic Description" + "Package description line started with space: Basic Description") + +(deffailure-pkg-test + "Ended with space" + "Basic Description " + "Package description line ended with space: Basic Description ") + +(deffailure-struc-test + "Two empty lines" + "Basic description + + +More information" + "Structure description has two empty lines in it") + +(deffailure-struc-test + "Line too long" + (format nil "~A~A" + "Unused package with a first line that is extremely long, and how could it be so" + "long and it keeps going and going and going and going and going and going") + (format nil "~A~A~A" + "Structure description longer than 120 characters: " + "Unused package with a first line that is extremely long, and how could it be so" + "long and it keeps going and going and going and going and going and going")) + +(deffailure-struc-test + "Started with space" + " Basic Description" + "Structure description line started with space: Basic Description") + +(deffailure-struc-test + "Ended with space" + "Basic Description " + "Structure description line ended with space: Basic Description ") diff --git a/src/test/main.lisp b/src/test/main.lisp index 9db1bc7..4c5dede 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -1,7 +1,10 @@ ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3. See distributed LICENSE.txt. (in-package #:sheep-test) -(defvar *tests* nil) +(defparameter *tests* nil) + +; Used just for tests +(defstruct unused-struc) ; This really is just here to check against regressions (defun run-all-tests () @@ -34,6 +37,7 @@ (handler-case (progn (load ,source) + (sheep:pretty-print-validate-packages ,pkg) (string= (slurp-file ,target) (sheep:export-package ,pkg))) (sheep:validation-failure (vf) (format t "Validation failure gotten: ~A~%" @@ -47,6 +51,10 @@ (load ,source) (let ((result (sheep:validate-package ,pkg))) + (let + ((*error-output* (make-broadcast-stream)) + (*standard-output* (make-broadcast-stream))) + (sheep:pretty-print-validate-packages ,pkg)) (or (equal ,expected result) (format t " Got error:~%~S~% but expected~%~S~%" result ,expected))))))) @@ -57,10 +65,8 @@ (lambda () (handler-case (progn - (funcall - (symbol-function (find-symbol "INTERNAL-DOC->AST" :sheep-func)) - 'unused - ,doc) + (setf (documentation 'unused 'function) ,doc) + (sheep-func:doc->ast 'unused) nil) (sheep:validation-failure (vf) (let @@ -75,10 +81,40 @@ (lambda () (handler-case (progn - (funcall - (symbol-function (find-symbol "INTERNAL-DOC->AST" :sheep-var)) - '*unused* - ,doc) + (setf (documentation '*unused* 'variable) ,doc) + (sheep-var:doc->ast '*unused*) + nil) + (sheep:validation-failure (vf) + (let + ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf))) + (or + (string= ,expected result) + (format t " Got error:~%~S~% but expected~%~S~%" result ,expected)))))))) + +(defmacro deffailure-pkg-test (name doc expected) + `(deftest + ,(format nil "Package - ~A" name) + (lambda () + (handler-case + (progn + (setf (documentation (find-package :sheep-unused) t) ,doc) + (sheep-pkg:doc->ast (find-package :sheep-unused)) + nil) + (sheep:validation-failure (vf) + (let + ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf))) + (or + (string= ,expected result) + (format t " Got error:~%~S~% but expected~%~S~%" result ,expected)))))))) + +(defmacro deffailure-struc-test (name doc expected) + `(deftest + ,(format nil "Struct - ~A" name) + (lambda () + (handler-case + (progn + (setf (documentation 'unused-struc 'structure) ,doc) + (sheep-struc:doc->ast 'unused-struc) nil) (sheep:validation-failure (vf) (let diff --git a/src/test/package.lisp b/src/test/package.lisp index 39b83ed..e878027 100644 --- a/src/test/package.lisp +++ b/src/test/package.lisp @@ -1,3 +1,6 @@ ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3. See distributed LICENSE.txt. (defpackage #:sheep-test (:use :common-lisp) (:export :run-all-tests)) + +; This package is for testing documentation of packages +(defpackage #:sheep-unused) -- 2.25.1