From: Frank Duncan Date: Mon, 27 Dec 2021 19:10:06 +0000 (-0600) Subject: Rename projects, docgen->sheep, checkstyle->wolf X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=wolf;a=commitdiff_plain;h=981fd3d9a7ad7e2b2dc4e92c5b594e6b2684a888 Rename projects, docgen->sheep, checkstyle->wolf --- diff --git a/.candle b/.candle index a69e7fd..f31a745 100644 --- a/.candle +++ b/.candle @@ -1,11 +1,11 @@ -(:packages :style-checker :style-checker-test :docgen) -(:name :style-checker +(:packages :wolf :wolf-test :sheep) +(:name :wolf :tasks ((:name :test - :directions (style-checker-test:run-all-tests)) - (:name :checkstyle :directions - (syntax-checker:pretty-print-check-directory "src")) - (:name :docgen :directions - (docgen:pretty-print-validate-packages :syntax-checker)))) + :directions (wolf-test:run-all-tests)) + (:name :wolf :directions + (wolf:pretty-print-check-directory "src")) + (:name :sheep :directions + (sheep:pretty-print-validate-packages :wolf)))) ; vim:ft=lisp diff --git a/README.md b/README.md index 37409b9..0707073 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # Common Lisp Style Checker Enforcement of my guidelines for common lisp style. -If you like, you can [download it](https://github.com/frankduncan/style-checker/releases/download/0.1/style-checker_0.1.tar.gz) +If you like, you can [download it](https://github.com/frankduncan/wolf/releases/download/0.1/wolf_0.1.tar.gz) ## Syntax Checking Rules * Elements on new line in each form must be indented the same amount diff --git a/bin/buildRelease.sh b/bin/buildRelease.sh index d5c1019..1d6161b 100755 --- a/bin/buildRelease.sh +++ b/bin/buildRelease.sh @@ -1,13 +1,13 @@ #!/bin/bash -version=$(sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options --eval '(format t "~A" (asdf:component-version (asdf:find-system :style-checker)))' --eval "(quit)") +version=$(sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options --eval '(format t "~A" (asdf:component-version (asdf:find-system :wolf)))' --eval "(quit)") echo -n "Building version $version, hit enter to continue" read -mkdir style-checker_$version -cp -ap src/main/* style-checker_$version/ -tar zcf style-checker_${version}.tar.gz style-checker_$version/ -rm -rf style-checker_$version +mkdir wolf_$version +cp -ap src/main/* wolf_$version/ +tar zcf wolf_${version}.tar.gz wolf_$version/ +rm -rf wolf_$version -echo "All done, it's in style-checker_${version}.tar.gz, you should tag it and push it up to github" +echo "All done, it's in wolf_${version}.tar.gz, you should tag it and push it up to github" diff --git a/bin/generatedocs.sh b/bin/generatedocs.sh index 25af9b8..324979a 100755 --- a/bin/generatedocs.sh +++ b/bin/generatedocs.sh @@ -1,8 +1,8 @@ #!/bin/bash sbcl \ - --eval "(asdf:load-system :docgen)" \ - --eval "(asdf:load-system :style-checker)" \ + --eval "(asdf:load-system :sheep)" \ + --eval "(asdf:load-system :wolf)" \ --eval "(format t \"----~%\")" \ - --eval "(format t \"~A\" (docgen:export-package :syntax-checker))" \ + --eval "(format t \"~A\" (sheep:export-package :wolf))" \ --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2 > wiki/Home.md diff --git a/bin/test.sh b/bin/test.sh index e4cb97d..0c3b572 100755 --- a/bin/test.sh +++ b/bin/test.sh @@ -1,4 +1,4 @@ #!/bin/bash -sbcl --eval "(asdf:load-system :style-checker)" --eval '(syntax-checker:pretty-print-check-directory "src")' -sbcl --eval "(asdf:load-system :style-checker)" --eval '(syntax-checker:pretty-print-check-directory "resources")' +sbcl --eval "(asdf:load-system :wolf)" --eval '(wolf:pretty-print-check-directory "src")' +sbcl --eval "(asdf:load-system :wolf)" --eval '(wolf:pretty-print-check-directory "resources")' diff --git a/src/main/package.lisp b/src/main/package.lisp index 504f2ac..5053c00 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,4 +1,4 @@ -(defpackage #:syntax-checker (:use :cl) +(defpackage #:wolf (:use :cl) (:export #:check-file #:check-directory #:pretty-print-check-directory) (:documentation "Enforces arbitrary set of style guidelines. diff --git a/src/main/style-checker.asd b/src/main/style-checker.asd deleted file mode 100644 index efbec3e..0000000 --- a/src/main/style-checker.asd +++ /dev/null @@ -1,8 +0,0 @@ -(asdf:defsystem style-checker - :name "Style Checker" - :version "0.1" - :maintainer "Frank Duncan (frank@kank.com)" - :author "Frank Duncan (frank@kank.com)" - :components ((:file "package") (:file "syntax-checker")) - :serial t - :depends-on (:cl-ppcre)) diff --git a/src/main/syntax-checker.lisp b/src/main/syntax-checker.lisp deleted file mode 100644 index f6c31da..0000000 --- a/src/main/syntax-checker.lisp +++ /dev/null @@ -1,319 +0,0 @@ -(in-package #:syntax-checker) - -; Some thoughts -; - form starting reader macros will have to be hand added to this code -; - exceptions will eventually arise, and the rule file will have to be changed -; - the proper formatting of "loop" is weird - -(define-condition check-failure nil ((msg :initarg :msg :reader check-failure-msg) - (line-no :initarg :line-no :reader check-failure-line-no) - (col-no :initarg :col-no :reader check-failure-col-no))) - -(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) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *possible-states* - '(:begin ; start of file - :normal ; normal processing - :beginning-of-line - :beginning-of-line-with-separator ; empty space in there - :beginning-of-symbols - :beginning-of-symbols-with-separator - :comment-with-separator ; weird edge case for pre-function comments - :beginning-of-line-with-comment-and-separator ; weird edge case part 2 - :first-symbol ; first symbol of form/line - :all ; matches everything - :in-string))) - -(defun set-state (state) - (when (not (find state *possible-states*)) - (error "Can't set state to ~A" state)) - (setf *state* state) - nil) - -(defmacro defevaluator (state match func) - (when (not (find state *possible-states*)) (error "~A is an invalid state" state)) - (let - ((scanner (gensym))) - `(let - ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match)))) - (pushnew - (list - (lambda (state text) - (and - (or (eql :all ,state) (eql ,state state)) - (or - (and (symbolp text) (eql text ,match)) - (and - ,scanner - (stringp text) - (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text) - (and start end (= 0 start))))))) - (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text)))) - ,func) - *evaluators*)))) - -(defun evaluate (text) - (if (string= "" text) - (let* - ((evaluator (find-if (lambda (f) (funcall f *state* :eof)) *evaluators* :from-end t :key #'car)) - (problem (when evaluator (funcall (third evaluator))))) - (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*)))) - (let - ((evaluator (find-if (lambda (f) (funcall f *state* text)) *evaluators* :from-end t :key #'car))) - (when (not evaluator) - (error - (make-condition 'check-failure - :msg (format nil "Can't check in state ~S: ~S..." - *state* (subseq text 0 (min (length text) 10))) :line-no *line-no* :col-no *col-no*))) - (let - ((problem (funcall (third evaluator)))) - (when problem - (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*))) - (let - ((length-of-match (funcall (cadr evaluator) text))) - (incf *col-no* length-of-match) - (when (< 120 *col-no*) - (error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no 0))) - (evaluate (subseq text length-of-match))))))) - -(defun slurp-file (filename &key (element-type 'character) (sequence-type 'string)) - (with-open-file (str filename :element-type element-type) - (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq))) - -(defun check-file (file) - "CHECK-FILE FILE => RESULT - - RESULT: SUCCESS-RESULT | FAILURE-RESULT - SUCCESS-RESULT: (:success FILENAME) - FAILURE-RESULT: (:success FILENAME MSG LINE-NO COL-NO) - -ARGUMENTS AND VALUES: - - FILE: a pathname - FILENAME: the file this check was run on - MSG: a string containing the failure message - LINE-NO: an integer, the line number on which the failure appeared - COL-NO: an integer, the column number on which the failure appeared - -DESCRIPTION: - - CHECK-FILE runs all the checks against a file and returns - as soon as the first style error is found. - -EXAMPLES: - - (check-file #P\"path/to/file.lisp\") => (:success \"path/to/file.lisp\") - (check-file #P\"path/to/error.lisp\") => (:failure \"path/to/error.lisp\" \"File cannot end with empty line\" 20 0)" - - (if (string= "package" (pathname-name file)) - (set-state :normal) - (set-state :begin)) - (setf *line-no* 0) - (setf *col-no* 0) - (setf *form-stack* nil) - (setf *form-ended-on-same-line* nil) - (handler-case - (progn - (evaluate (slurp-file file)) - (list :success file)) - (check-failure (cf) - (list :failure file (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))))) - -(defun check-directory (dir) - "CHECK-DIRECTORY DIR => RESULTS - - RESULTS: RESULT* - -ARGUMENTS AND VALUES: - - DIR: A directory to recurse into and check files - RESULT: A result as returned by check-file - -DESCRIPTION: - - CHECK-DIRECTORY grabs all .lisp files in the tree under DIR, and loads - checks them all. - - The results are then put together into a list which can be programatically - evaluated. As opposed to pretty-print-check-directory, this function doesn't - clutter up your standard out." - (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir)))) - -(defun any-failures (checks) - (find :failure checks :key #'car)) - -(defun print-failure (failure) - (format nil - "Style error in ~A at ~A:~A: ~A~%- ~A~%~VT^" - (second failure) - (1+ (fourth failure)) - (1+ (fifth failure)) - (third failure) - (with-open-file (str (second failure)) (loop :repeat (fourth failure) :do (read-line str)) (read-line str)) - (+ (fifth failure) 2))) - -(defun pretty-print-check-directory (dir) - "PRETTY-PRINT-CHECK-DIRECTORY DIR => SUCCESS - -ARGUMENTS AND VALUES: - - DIR: A directory to recurse into and check files - SUCCESS: T if there were no failures - -DESCRIPTION: - - PRETTY-PRINT-CHECK-DIRECTORY checks DIR for any errors, dumping them to output - and returning a single flag. - - Unlike check-directory, PRETTY-PRINT-CHECK-DIRECTORY is built for continuous - integration, dumping errors to standard out and returning a singular result. - -EXAMPLES: - - (pretty-print-check-directory \"src\") => nil" - (let - ((checks (check-directory dir))) - (format t "In ~A: Checked ~A files with ~A failures~%~%" - dir (length checks) (length (remove :success checks :key #'car))) - (format t "~{~A~%~}" (mapcar #'print-failure (remove :success checks :key #'car))) - (not (any-failures checks)))) - -; These are in reverse order -(defevaluator :beginning-of-symbols " *;[^\\n]*" - (lambda () (set-state :normal))) - -(defevaluator :beginning-of-symbols-with-separator " *;[^\\n]*" - (lambda () (set-state :comment-with-separator))) - -(defevaluator :normal " *;[^\\n]*" - (lambda () (set-state :normal))) - -(defevaluator :normal "\\(" - (lambda () - (push (list *line-no* *col-no*) *form-stack*) - (set-state :first-symbol))) - -(defevaluator :first-symbol "\\(" - (lambda () - (cond - ((and (not *form-stack*) (not (zerop *col-no*))) "Top level forms must begin on first column") - ((and *form-stack* (/= (1+ (cadr (car *form-stack*))) *col-no*)) - "All form elements must be indented equally") - (t - (push (list *line-no* *col-no*) *form-stack*) - (set-state :first-symbol))))) - -(defevaluator :all "\\t" (constantly "Must not use tabs")) - -(defevaluator :begin "\\(in-package[^\\)]*\\)" (lambda () (set-state :normal))) - -(defevaluator :beginning-of-line-with-separator :eof - (lambda () - (incf *line-no* -1) - "Must not end with empty line")) - -(defevaluator :beginning-of-line-with-separator "\\n" (constantly "Must not have two empty lines in a row")) - -(defevaluator :begin ".*" (constantly "Must begin with in-package form")) - -(defevaluator :all "\\( *in-package " (constantly "Only one in-package per file")) - -(defevaluator :normal "\\n" - (lambda () - (incf *line-no*) - (setf *col-no* -1) - (set-state :beginning-of-line))) - -(defevaluator :comment-with-separator "\\n" - (lambda () - (incf *line-no*) - (setf *col-no* -1) - (set-state :beginning-of-line-with-comment-and-separator) - nil)) - -(defevaluator :normal " +\\n" (constantly "No whitespace at end of line")) - -(defevaluator :beginning-of-line " *" (lambda () (set-state :beginning-of-symbols))) - -(defevaluator :beginning-of-line-with-separator " *" (lambda () (set-state :beginning-of-symbols-with-separator))) - -(defevaluator :beginning-of-line-with-comment-and-separator "\\n" - (lambda () - (progn - (incf *line-no*) - (setf *col-no* -1) - (set-state :beginning-of-line-with-separator)))) - -(defevaluator :beginning-of-line-with-comment-and-separator " *" - (lambda () (set-state :beginning-of-symbols-with-separator))) - -(defevaluator :beginning-of-symbols "\\n" - (lambda () - (if - (< 0 *col-no*) - "No whitespace only lines" - (progn - (incf *line-no*) - (setf *col-no* -1) - (set-state :beginning-of-line-with-separator))))) - -(defevaluator :beginning-of-symbols "\\)" (constantly "No hanging close parens")) - -(defevaluator :beginning-of-symbols-with-separator "\\)" (constantly "No hanging close parens")) - -(defevaluator :beginning-of-symbols "" - (lambda () - (if - (and (not *form-stack*) (not *form-ended-on-same-line*)) - "Multiline top level forms must be separated by a space" - (set-state :first-symbol)))) - -(defevaluator :beginning-of-symbols-with-separator "" - (lambda () - (set-state :first-symbol))) - -(defevaluator :normal "\\)" - (lambda () - (let - ((form (pop *form-stack*))) - (cond - ((not form) "Unmatched ending paren") - ((< 50 (- *line-no* (car form))) "Forms can't be over 50 lines long") - (t (setf *form-ended-on-same-line* (= *line-no* (car form))) nil))))) - -(defevaluator :normal "::" (constantly "No internal symbols from other packages")) - -(defevaluator :in-string "\\\\\"" (constantly nil)) - -(defevaluator :normal "\"" (lambda () (set-state :in-string))) - -(defevaluator :in-string "\"" (lambda () (set-state :normal))) - -(defevaluator :in-string "\\n" - (lambda () - (incf *line-no*) - (setf *col-no* -1) - nil)) - -(defevaluator :in-string "." (constantly nil)) - -(defevaluator :first-symbol "\\n" (constantly "No new line after opening form")) - -(defevaluator :first-symbol " " (constantly "No space after opening parens")) - -(defevaluator :first-symbol "" - (lambda () - (cond - ((and *form-stack* (/= (1+ (cadr (car *form-stack*))) *col-no*)) - "All form elements must be indented equally") - (t (set-state :normal))))) - -(defevaluator :normal " " (constantly "Only one space between items of a form")) - -(defevaluator :normal "." (constantly nil)) diff --git a/src/main/wolf.asd b/src/main/wolf.asd new file mode 100644 index 0000000..3671f2e --- /dev/null +++ b/src/main/wolf.asd @@ -0,0 +1,8 @@ +(asdf:defsystem wolf + :name "Wolf - A syntax checking utility for common lisp" + :version "0.1" + :maintainer "Frank Duncan (frank@consxy.com)" + :author "Frank Duncan (frank@consxy.com)" + :components ((:file "package") (:file "wolf")) + :serial t + :depends-on (:cl-ppcre)) diff --git a/src/main/wolf.lisp b/src/main/wolf.lisp new file mode 100644 index 0000000..d6f60e3 --- /dev/null +++ b/src/main/wolf.lisp @@ -0,0 +1,319 @@ +(in-package #:wolf) + +; Some thoughts +; - form starting reader macros will have to be hand added to this code +; - exceptions will eventually arise, and the rule file will have to be changed +; - the proper formatting of "loop" is weird + +(define-condition check-failure nil ((msg :initarg :msg :reader check-failure-msg) + (line-no :initarg :line-no :reader check-failure-line-no) + (col-no :initarg :col-no :reader check-failure-col-no))) + +(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) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *possible-states* + '(:begin ; start of file + :normal ; normal processing + :beginning-of-line + :beginning-of-line-with-separator ; empty space in there + :beginning-of-symbols + :beginning-of-symbols-with-separator + :comment-with-separator ; weird edge case for pre-function comments + :beginning-of-line-with-comment-and-separator ; weird edge case part 2 + :first-symbol ; first symbol of form/line + :all ; matches everything + :in-string))) + +(defun set-state (state) + (when (not (find state *possible-states*)) + (error "Can't set state to ~A" state)) + (setf *state* state) + nil) + +(defmacro defevaluator (state match func) + (when (not (find state *possible-states*)) (error "~A is an invalid state" state)) + (let + ((scanner (gensym))) + `(let + ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match)))) + (pushnew + (list + (lambda (state text) + (and + (or (eql :all ,state) (eql ,state state)) + (or + (and (symbolp text) (eql text ,match)) + (and + ,scanner + (stringp text) + (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text) + (and start end (= 0 start))))))) + (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text)))) + ,func) + *evaluators*)))) + +(defun evaluate (text) + (if (string= "" text) + (let* + ((evaluator (find-if (lambda (f) (funcall f *state* :eof)) *evaluators* :from-end t :key #'car)) + (problem (when evaluator (funcall (third evaluator))))) + (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*)))) + (let + ((evaluator (find-if (lambda (f) (funcall f *state* text)) *evaluators* :from-end t :key #'car))) + (when (not evaluator) + (error + (make-condition 'check-failure + :msg (format nil "Can't check in state ~S: ~S..." + *state* (subseq text 0 (min (length text) 10))) :line-no *line-no* :col-no *col-no*))) + (let + ((problem (funcall (third evaluator)))) + (when problem + (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*))) + (let + ((length-of-match (funcall (cadr evaluator) text))) + (incf *col-no* length-of-match) + (when (< 120 *col-no*) + (error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no 0))) + (evaluate (subseq text length-of-match))))))) + +(defun slurp-file (filename &key (element-type 'character) (sequence-type 'string)) + (with-open-file (str filename :element-type element-type) + (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq))) + +(defun check-file (file) + "CHECK-FILE FILE => RESULT + + RESULT: SUCCESS-RESULT | FAILURE-RESULT + SUCCESS-RESULT: (:success FILENAME) + FAILURE-RESULT: (:success FILENAME MSG LINE-NO COL-NO) + +ARGUMENTS AND VALUES: + + FILE: a pathname + FILENAME: the file this check was run on + MSG: a string containing the failure message + LINE-NO: an integer, the line number on which the failure appeared + COL-NO: an integer, the column number on which the failure appeared + +DESCRIPTION: + + CHECK-FILE runs all the checks against a file and returns + as soon as the first style error is found. + +EXAMPLES: + + (check-file #P\"path/to/file.lisp\") => (:success \"path/to/file.lisp\") + (check-file #P\"path/to/error.lisp\") => (:failure \"path/to/error.lisp\" \"File cannot end with empty line\" 20 0)" + + (if (string= "package" (pathname-name file)) + (set-state :normal) + (set-state :begin)) + (setf *line-no* 0) + (setf *col-no* 0) + (setf *form-stack* nil) + (setf *form-ended-on-same-line* nil) + (handler-case + (progn + (evaluate (slurp-file file)) + (list :success file)) + (check-failure (cf) + (list :failure file (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))))) + +(defun check-directory (dir) + "CHECK-DIRECTORY DIR => RESULTS + + RESULTS: RESULT* + +ARGUMENTS AND VALUES: + + DIR: A directory to recurse into and check files + RESULT: A result as returned by check-file + +DESCRIPTION: + + CHECK-DIRECTORY grabs all .lisp files in the tree under DIR, and loads + checks them all. + + The results are then put together into a list which can be programatically + evaluated. As opposed to pretty-print-check-directory, this function doesn't + clutter up your standard out." + (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir)))) + +(defun any-failures (checks) + (find :failure checks :key #'car)) + +(defun print-failure (failure) + (format nil + "Style error in ~A at ~A:~A: ~A~%- ~A~%~VT^" + (second failure) + (1+ (fourth failure)) + (1+ (fifth failure)) + (third failure) + (with-open-file (str (second failure)) (loop :repeat (fourth failure) :do (read-line str)) (read-line str)) + (+ (fifth failure) 2))) + +(defun pretty-print-check-directory (dir) + "PRETTY-PRINT-CHECK-DIRECTORY DIR => SUCCESS + +ARGUMENTS AND VALUES: + + DIR: A directory to recurse into and check files + SUCCESS: T if there were no failures + +DESCRIPTION: + + PRETTY-PRINT-CHECK-DIRECTORY checks DIR for any errors, dumping them to output + and returning a single flag. + + Unlike check-directory, PRETTY-PRINT-CHECK-DIRECTORY is built for continuous + integration, dumping errors to standard out and returning a singular result. + +EXAMPLES: + + (pretty-print-check-directory \"src\") => nil" + (let + ((checks (check-directory dir))) + (format t "In ~A: Checked ~A files with ~A failures~%~%" + dir (length checks) (length (remove :success checks :key #'car))) + (format t "~{~A~%~}" (mapcar #'print-failure (remove :success checks :key #'car))) + (not (any-failures checks)))) + +; These are in reverse order +(defevaluator :beginning-of-symbols " *;[^\\n]*" + (lambda () (set-state :normal))) + +(defevaluator :beginning-of-symbols-with-separator " *;[^\\n]*" + (lambda () (set-state :comment-with-separator))) + +(defevaluator :normal " *;[^\\n]*" + (lambda () (set-state :normal))) + +(defevaluator :normal "\\(" + (lambda () + (push (list *line-no* *col-no*) *form-stack*) + (set-state :first-symbol))) + +(defevaluator :first-symbol "\\(" + (lambda () + (cond + ((and (not *form-stack*) (not (zerop *col-no*))) "Top level forms must begin on first column") + ((and *form-stack* (/= (1+ (cadr (car *form-stack*))) *col-no*)) + "All form elements must be indented equally") + (t + (push (list *line-no* *col-no*) *form-stack*) + (set-state :first-symbol))))) + +(defevaluator :all "\\t" (constantly "Must not use tabs")) + +(defevaluator :begin "\\(in-package[^\\)]*\\)" (lambda () (set-state :normal))) + +(defevaluator :beginning-of-line-with-separator :eof + (lambda () + (incf *line-no* -1) + "Must not end with empty line")) + +(defevaluator :beginning-of-line-with-separator "\\n" (constantly "Must not have two empty lines in a row")) + +(defevaluator :begin ".*" (constantly "Must begin with in-package form")) + +(defevaluator :all "\\( *in-package " (constantly "Only one in-package per file")) + +(defevaluator :normal "\\n" + (lambda () + (incf *line-no*) + (setf *col-no* -1) + (set-state :beginning-of-line))) + +(defevaluator :comment-with-separator "\\n" + (lambda () + (incf *line-no*) + (setf *col-no* -1) + (set-state :beginning-of-line-with-comment-and-separator) + nil)) + +(defevaluator :normal " +\\n" (constantly "No whitespace at end of line")) + +(defevaluator :beginning-of-line " *" (lambda () (set-state :beginning-of-symbols))) + +(defevaluator :beginning-of-line-with-separator " *" (lambda () (set-state :beginning-of-symbols-with-separator))) + +(defevaluator :beginning-of-line-with-comment-and-separator "\\n" + (lambda () + (progn + (incf *line-no*) + (setf *col-no* -1) + (set-state :beginning-of-line-with-separator)))) + +(defevaluator :beginning-of-line-with-comment-and-separator " *" + (lambda () (set-state :beginning-of-symbols-with-separator))) + +(defevaluator :beginning-of-symbols "\\n" + (lambda () + (if + (< 0 *col-no*) + "No whitespace only lines" + (progn + (incf *line-no*) + (setf *col-no* -1) + (set-state :beginning-of-line-with-separator))))) + +(defevaluator :beginning-of-symbols "\\)" (constantly "No hanging close parens")) + +(defevaluator :beginning-of-symbols-with-separator "\\)" (constantly "No hanging close parens")) + +(defevaluator :beginning-of-symbols "" + (lambda () + (if + (and (not *form-stack*) (not *form-ended-on-same-line*)) + "Multiline top level forms must be separated by a space" + (set-state :first-symbol)))) + +(defevaluator :beginning-of-symbols-with-separator "" + (lambda () + (set-state :first-symbol))) + +(defevaluator :normal "\\)" + (lambda () + (let + ((form (pop *form-stack*))) + (cond + ((not form) "Unmatched ending paren") + ((< 50 (- *line-no* (car form))) "Forms can't be over 50 lines long") + (t (setf *form-ended-on-same-line* (= *line-no* (car form))) nil))))) + +(defevaluator :normal "::" (constantly "No internal symbols from other packages")) + +(defevaluator :in-string "\\\\\"" (constantly nil)) + +(defevaluator :normal "\"" (lambda () (set-state :in-string))) + +(defevaluator :in-string "\"" (lambda () (set-state :normal))) + +(defevaluator :in-string "\\n" + (lambda () + (incf *line-no*) + (setf *col-no* -1) + nil)) + +(defevaluator :in-string "." (constantly nil)) + +(defevaluator :first-symbol "\\n" (constantly "No new line after opening form")) + +(defevaluator :first-symbol " " (constantly "No space after opening parens")) + +(defevaluator :first-symbol "" + (lambda () + (cond + ((and *form-stack* (/= (1+ (cadr (car *form-stack*))) *col-no*)) + "All form elements must be indented equally") + (t (set-state :normal))))) + +(defevaluator :normal " " (constantly "Only one space between items of a form")) + +(defevaluator :normal "." (constantly nil)) diff --git a/src/test/main.lisp b/src/test/main.lisp index 3278681..e1176db 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -1,4 +1,4 @@ -(in-package #:style-checker-test) +(in-package #:wolf-test) (defvar *tests* nil) @@ -8,7 +8,7 @@ (let ((green (format nil "~c[1;32m" #\Esc)) (red (format nil "~c[1;31m" #\Esc)) - (result (syntax-checker:check-file ,filename))) + (result (wolf:check-file ,filename))) (cond ((not (eql ,success (car result))) (format t "~A- ~A failed, expected ~A and got ~A~c[0m~%" diff --git a/src/test/package.lisp b/src/test/package.lisp index 26eb90c..3d11409 100644 --- a/src/test/package.lisp +++ b/src/test/package.lisp @@ -1,2 +1,2 @@ -(defpackage #:style-checker-test (:use :common-lisp) +(defpackage #:wolf-test (:use :common-lisp) (:export :run-all-tests)) diff --git a/src/test/style-checker-test.asd b/src/test/style-checker-test.asd deleted file mode 100644 index 02661cb..0000000 --- a/src/test/style-checker-test.asd +++ /dev/null @@ -1,8 +0,0 @@ -(asdf:defsystem style-checker-test - :name "Style Checker Tests" - :version "0.1" - :maintainer "Frank Duncan (frank@kank.com)" - :author "Frank Duncan (frank@kank.com)" - :serial t - :components ((:file "package") (:file "main")) - :depends-on (:style-checker)) diff --git a/src/test/wolf-test.asd b/src/test/wolf-test.asd new file mode 100644 index 0000000..daa8d88 --- /dev/null +++ b/src/test/wolf-test.asd @@ -0,0 +1,8 @@ +(asdf:defsystem wolf-test + :name "Wolf Tests" + :version "0.1" + :maintainer "Frank Duncan (frank@kank.com)" + :author "Frank Duncan (frank@kank.com)" + :serial t + :components ((:file "package") (:file "main")) + :depends-on (:wolf))