-(: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."))
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))
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
## 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.
* **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\*
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:
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:
(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
(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)))
(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
(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))))
(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))))))
(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)
(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)))
(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
(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)
((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)
(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))))
"
"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
"
"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*
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 ")
; 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 ()
(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~%"
(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)))))))
(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
(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
; 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)
projects / sheep / commitdiff