hacky eval-on-compile

common-lisp.lisp

(in-package #:fouric)

;; TODO: ask whether to use symbol-plists or hash tables
;; actually, should almost certainly use a hash table in the fouric package, to prevent pollution...
;; or maybe just need to CLEAR-TESTS for everything before deploying binary
;; TODO: ask #lisp and lisp discord about this

(defun run-tests (name)
  ;;(format t "~&running tests for ~a::~s~%" (package-name (symbol-package name)) name)
  (a:doplist (test-name test-function (get name 'function-tests))
      ;;(format t "~&running test named ~s~%" test-name)
    (funcall test-function)))

(defun add-test (function-name test-name &optional test)
  ;; (get function-name 'function-tests) returns the property list value for 'function-tests for the symbol given in FUNCTION-NAME
  ;; now that we have the 'function-tests property, we're going to store a plist in it
  ;; the keys of the plist are going to be symbols naming tests, and the values are going to be functions to be run
  (setf (getf (get function-name 'function-tests) test-name) (or test (symbol-function test-name))))

(defun remove-test (function-name test-name)
  (a:remove-from-plistf (get function-name 'function-tests) test-name))

(defun list-tests (function-name)
  (get function-name 'function-tests))

(defun clear-tests (function-name)
  (setf (get function-name 'function-tests) nil))

elisp.el

(setq waiting-for-compile nil)

(defun watch-compile-finish (&rest args)
  ;;(print "print-hook")
  ;;(print args)
  ;;(print (apply #'buffer-substring-no-properties args))
  ;;(print (read-from-string (apply #'buffer-substring-no-properties args)))
  (let ((form (first (read-from-string (apply #'buffer-substring-no-properties args)))))
    (if (>= (length form) 1)
        (let ((form-name (first form)))
          (if (eq form-name 'defun)
              (if (>= (length form) 2)
                  (progn
                    ;;(message "defun with enough args: %s" (second form))
                    (push (second form) waiting-for-compile))
                ;;(message "[watch-compile-finish] not enough arguments to defun: %s" form)
                )
            ;;(message "[watch-compile-finish] not a defun: %s" form)
            ))
      ;;(message "[watch-compile-finish] not enough arguments to form: %s" form)
      )))

(defun compile-finish (&rest args)
  ;;(message "compilation finished, waiting-for-compile is %s" waiting-for-compile)
  (when waiting-for-compile
    (let ((name (pop waiting-for-compile)))
      (slime-interactive-eval (concat "(when (find-package :fouric) (funcall (intern \"RUN-TESTS\" :fouric) '" (symbol-name name) "))"))
      ;;(message "popped %s" name)
      )))

(add-hook 'slime-before-compile-functions 'watch-compile-finish)
(add-hook 'slime-compilation-finished-hook 'compile-finish)