Merge pull request #27 from johannes-mueller/dape-support

Dape support

README.md

@@ -118,7 +118,6 @@ suit you best.
   Like `test-cockpit-test-or-projectile-test` but does not fallback to
   projectile.
 
-
 You can also use the following commands to run tests in a more manual way
 
 * `test-cockpit-test-project` to run the whole test suite.
@@ -130,6 +129,17 @@ If the current function at point or the current module cannot be determined,
 the last tested module resp. last tested function are tested.  If there are no
 last tests, an error message is thrown.
 
+
+## Dape support
+
+There are stubs to make use of the [Dape](https://github.com/svaante/dape/)
+package to call the recent test run in a Dape debugging session.  So far, only
+the python backend supports this feature.
+
+You can call this either using the transient UI or by the command
+`test-cockpit-dape-debug-repeat-test`.
+
+
 ## Status
 
 The development started more than a year ago in early 2021.  Since then I have
@@ -141,7 +151,6 @@ out to work smoothly and to be quite useful.
 
 * Test discovery
 * Parsing test results to determine failed tests
-* dap-mode integration – launch lastly failed test in dap-mode
 * Generalizing it to a more comprehensive build-cockpit also doing simple
   builds and things like release uploads.
 

test-cockpit-python.el

@@ -42,6 +42,20 @@
   "Implement test-cockpit--engine-current-function-string."
   (test-cockpit-python--test-function-path))
 
+(cl-defmethod test-cockpit--engine-dape-last-test-config ((_obj test-cockpit-python-engine))
+  (let* ((last-cmd (test-cockpit--last-interactive-test-command))
+         (args (vconcat (pcase last-cmd
+                          ('test-cockpit-test-project [])
+                          ('test-cockpit-test-module `[,(test-cockpit--last-module-string)])
+                          ('test-cockpit-test-function `[,(test-cockpit--last-function-string)]))
+                        (oref (test-cockpit--retrieve-engine) last-args))))
+  `(command "python"
+    command-args ("-m" "debugpy.adapter" "--host" "127.0.0.1" "--port" :autoport)
+    port :autoport :request "launch" :type "python" :module "pytest"
+    :cwd ,(projectile-project-root)
+    :args ,args
+    :justMyCode nil :console "integratedTerminal" :showReturnValue t :stopOnEntry nil)))
+
 (test-cockpit-register-project-type 'python-pip 'test-cockpit-python-engine)
 (test-cockpit-register-project-type-alias 'python-pkg 'python-pip)
 (test-cockpit-register-project-type-alias 'python-tox 'python-pip)

test-cockpit.el

@@ -61,6 +61,8 @@
 ;; the last tested module resp. last tested function are tested.  If there are no
 ;; last tests, an error message is thrown.
 
+;; There is experimental state support of the Dape package to run DAP debug sessions.
+
 ;;; Code:
 
 (require 'transient)
@@ -137,6 +139,10 @@ the argument list passed to the test frame work."
   "Supply the string identifying the current function at point."
   nil)
 
+(cl-defmethod test-cockpit--engine-dape-last-test-config ((_obj test-cockpit--engine))
+  "Supply the dape testing configuration."
+  nil)
+
 (defun test-cockpit-register-project-type (project-type engine-class)
   "Register a language testing package.
 PROJECT-TYPE is the type given by `pojectile-project-type' and
@@ -211,6 +217,7 @@ The additional arguments are shipped as ARGS."
     (oset engine last-args args)))
 
 (defun test-cockpit--update-last-interactive-command (function)
+  "Update thte last interactive command function"
   (let ((engine (test-cockpit--retrieve-engine)))
     (oset engine last-interactive-cmd function)))
 
@@ -390,7 +397,9 @@ session, the main dispatch dialog is invoked."
   (interactive
    (list (transient-args 'test-cockpit-prefix)))
   (if-let (last-cmd (oref (test-cockpit--real-engine-or-error) last-command))
-      (test-cockpit--run-test last-cmd)
+      (if (eq last-cmd 'test-cockpit--last-command-was-dape)
+          (test-cockpit-dape-debug-repeat-test)
+      (test-cockpit--run-test last-cmd))
     (test-cockpit-dispatch)))
 
 ;;;###autoload
@@ -444,7 +453,6 @@ prompt to type a test command is shown."
       (test-cockpit--repeat-projectile-test)
     (test-cockpit-repeat-test)))
 
-
 ;;;###autoload
 (defun test-cockpit--repeat-interactive-test (&optional args)
   "Repeat the last interactive test command.
@@ -455,6 +463,19 @@ in order to call the last test action with modified ARGS."
   (when-let ((last-cmd (test-cockpit--last-interactive-test-command)))
     (funcall last-cmd args)))
 
+;;;###autoload
+(defun test-cockpit-dape-debug-repeat-test ()
+  "Repeat the last test action calling the dape debugger, if available."
+  (interactive)
+  (if-let
+      ((config (test-cockpit--dape-debug-last-test)))
+      (test-cockpit--launch-dape config)
+    (user-error "No recent test-action has been performed or no Dape support for backend")))
+
+(defun test-cockpit--launch-dape (config)
+  "Launch the dape debug session and memorize that last test was a dape session."
+  (dape config)
+  (oset (test-cockpit--retrieve-engine) last-command 'test-cockpit--last-command-was-dape))
 
 (defun test-cockpit--projectile-build (&optional last-cmd)
   "Launch a projectile driven build process.
@@ -522,6 +543,10 @@ repetition."
   "Get the last interactive test command."
   (oref (test-cockpit--retrieve-engine) last-interactive-cmd))
 
+(defun test-cockpit--dape-debug-last-test ()
+  "Get the dape configuration for the last test."
+  (test-cockpit--engine-dape-last-test-config (test-cockpit--retrieve-engine)))
+
 (transient-define-prefix test-cockpit-prefix ()
   "Test the project."
   :value 'test-cockpit--last-switches
@@ -531,7 +556,8 @@ repetition."
   "Setup the main menu common for all projects for testing."
   (let ((module-string (or (test-cockpit--current-module-string) (test-cockpit--last-module-string)))
         (function-string (or (test-cockpit--current-function-string) (test-cockpit--last-function-string)))
-        (last-cmd (oref (test-cockpit--real-engine-or-error) last-interactive-cmd)))
+        (dape-adaptor (test-cockpit--dape-debug-last-test))
+        (last-cmd (test-cockpit--last-interactive-test-command)))
     (vconcat (remove nil (append `("Run tests"
                                    ("p" "project" test-cockpit-test-project)
                                    ,(if module-string
@@ -542,6 +568,8 @@ repetition."
                                         `("f"
                                           ,(format "function: %s" (test-cockpit--strip-project-root function-string))
                                           test-cockpit-test-function))
+                                   ,(if (and dape-adaptor last-cmd)
+                                        `("d" "dape debug repeat" test-cockpit-dape-debug-repeat-test))
                                    ("c" "custom" test-cockpit-custom-test-command)
                                    ,(if last-cmd
                                         `("r" "repeat" test-cockpit--repeat-interactive-test))))))))

test/test-cockpit.el-test.el

@@ -42,6 +42,39 @@
   (should (eq (alist-get 'foo-project-type test-cockpit--project-types)
               (alist-get 'foo-project-type-alias test-cockpit--project-types))))
 
+
+(defclass test-cockpit--dape-engine (test-cockpit--engine)
+  ((current-module-string :initarg :current-module-string
+                         :initform nil)
+   (current-function-string :initarg :current-function-string
+                            :initform nil)))
+
+(cl-defmethod test-cockpit--test-project-command ((obj test-cockpit--dape-engine))
+  (lambda (_ args) (concat "test project" " " (string-join args " "))))
+(cl-defmethod test-cockpit--test-module-command ((obj test-cockpit--dape-engine))
+  (lambda (module args) (concat "test module" " " module " " (string-join args " "))))
+(cl-defmethod test-cockpit--test-function-command ((obj test-cockpit--dape-engine))
+  (lambda (func args) (concat "test function" " " func " " (string-join args " "))))
+(cl-defmethod test-cockpit--transient-infix ((obj test-cockpit--dape-engine))
+  ["Dape" ("-f" "dape" "--dape")])
+(cl-defmethod test-cockpit--engine-current-module-string ((obj test-cockpit--dape-engine))
+  (oref obj current-module-string))
+(cl-defmethod test-cockpit--engine-current-function-string ((obj test-cockpit--dape-engine))
+  (oref obj current-function-string))
+(cl-defmethod test-cockpit--engine-dape-last-test-config ((obj test-cockpit--dape-engine))
+  'dape-foo-config)
+
+(defun tc--register-dape-project (test-string)
+  (setq test-cockpit--project-engines nil)
+  (test-cockpit-register-project-type 'dape-project-type 'test-cockpit--dape-engine)
+  (mocker-let ((projectile-project-type () ((:output 'dape-project-type :min-occur 0)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "dape-project" :min-occur 0))))
+    (oset (test-cockpit--retrieve-engine) current-module-string
+          (when test-string (concat test-string "-module-string")))
+    (oset (test-cockpit--retrieve-engine) current-function-string
+          (when test-string (concat test-string "-function-string")))))
+
+
 (ert-deftest test-current-module-string-dummy ()
   (setq test-cockpit--project-engines nil)
   (mocker-let ((projectile-project-type () ((:output 'bar-project-type)))
@@ -361,6 +394,24 @@
     (test-cockpit-test-module '("bar" "foo"))
     (test-cockpit--do-repeat-function nil)))
 
+(ert-deftest test-dape-debug-repeat-test--not-available ()
+  (tc--register-foo-project "foo")
+  (should-error (test-cockpit-dape-debug-repeat-test)))
+
+(ert-deftest test-dape-debug-repeat-test--available ()
+  (tc--register-dape-project "dape")
+  (mocker-let ((projectile-project-type () ((:output 'dape-project-type)))
+               (dape (config) ((:input '(dape-foo-config) :output 'success))))
+    (test-cockpit-dape-debug-repeat-test)))
+
+
+(ert-deftest test-dape-debug-repeat-test--repeat ()
+  (tc--register-dape-project "dape")
+  (mocker-let ((projectile-project-type () ((:output 'dape-project-type)))
+               (dape (config) ((:input '(dape-foo-config) :output 'success :occur 2))))
+    (test-cockpit-dape-debug-repeat-test)
+    (test-cockpit-repeat-test)))
+
 
 (ert-deftest test-main-suffix--all-nil ()
   (tc--register-foo-project "foo")
@@ -426,6 +477,36 @@
                     ("f" "function: some-last-function" test-cockpit-test-function)
                     ("c" "custom" test-cockpit-custom-test-command)]))))
 
+(ert-deftest test-main-suffix-dape-debug-no-last-test ()
+  (tc--register-dape-project "dape")
+  (mocker-let ((projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "dape-project")))
+               (test-cockpit--current-module-string () ((:output nil)))
+               (test-cockpit--current-function-string () ((:output nil)))
+               (test-cockpit--last-module-string () ((:output nil)))
+               (test-cockpit--last-function-string () ((:output "dape-project/some-last-function")))
+               (test-cockpit--last-interactive-test-command () ((:output nil))))
+    (should (equal (test-cockpit--main-suffix)
+                   ["Run tests"
+                    ("p" "project" test-cockpit-test-project)
+                    ("f" "function: some-last-function" test-cockpit-test-function)
+                    ("c" "custom" test-cockpit-custom-test-command)]))))
+
+(ert-deftest test-main-suffix-dape-debug-with-last-test ()
+  (tc--register-dape-project "dape")
+  (mocker-let ((projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "dape-project")))
+               (test-cockpit--current-module-string () ((:output nil)))
+               (test-cockpit--current-function-string () ((:output nil)))
+               (test-cockpit--last-module-string () ((:output nil)))
+               (test-cockpit--last-function-string () ((:output "dape-project/some-last-function")))
+               (test-cockpit--last-interactive-test-command () ((:output 'some-cmd))))
+    (should (equal (test-cockpit--main-suffix)
+                   ["Run tests"
+                    ("p" "project" test-cockpit-test-project)
+                    ("f" "function: some-last-function" test-cockpit-test-function)
+                    ("d" "dape debug repeat" test-cockpit-dape-debug-repeat-test)
+                    ("c" "custom" test-cockpit-custom-test-command)
+                    ("r" "repeat" test-cockpit--repeat-interactive-test)]))))
+
 
 (ert-deftest test-repeat-transient-suffix-nil ()
   (tc--register-foo-project "foo")

test/test-python.el-test.el

@@ -146,6 +146,58 @@
           (expected (pop struct)))
       (should (equal (test-cockpit-python--insert-no-coverage-to-switches arglist) expected)))))
 
+(ert-deftest test-python-dape-last-test-project ()
+  (setq test-cockpit--project-engines nil)
+  (mocker-let
+      ((projectile-project-type () ((:output 'python-pip :occur 1)))
+       (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "foo-project")))
+       (compile (command) ((:input-matcher (lambda (_) t) :output 'success))))
+    (test-cockpit-test-project)
+    (should (equal (test-cockpit--dape-debug-last-test)
+                   '(command "python"
+                     command-args ("-m" "debugpy.adapter" "--host" "127.0.0.1" "--port" :autoport)
+                     port :autoport :request "launch" :type "python" :module "pytest"
+                     :cwd "foo-project"
+                     :args []
+                     :justMyCode nil :console "integratedTerminal" :showReturnValue t :stopOnEntry nil)))))
+
+(ert-deftest test-python-dape-last-test-module ()
+  (setq test-cockpit--project-engines nil)
+  (mocker-let
+      ((projectile-project-type () ((:output 'python-pip :occur 1)))
+       (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/home/user/project")))
+       (buffer-file-name () ((:output "/home/user/project/tests/path/to/test_foo.py")))
+       (compile (command) ((:input-matcher (lambda (_) t) :output 'success))))
+    (test-cockpit-test-module)
+    (let ((config (test-cockpit--dape-debug-last-test)))
+      (should (equal (plist-get config :cwd) "/home/user/project"))
+      (should (equal (plist-get config :args) ["tests/path/to/test_foo.py"])))))
+
+(ert-deftest test-python-dape-last-test-function-no-switches ()
+  (setq test-cockpit--project-engines nil)
+  (mocker-let
+      ((projectile-project-type () ((:output 'python-pip :occur 1)))
+       (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/home/user/project")))
+       (test-cockpit-python--test-function-path () ((:output "test_foo")))
+       (compile (command) ((:input-matcher (lambda (_) t) :output 'success))))
+    (test-cockpit-test-function)
+    (let ((config (test-cockpit--dape-debug-last-test)))
+      (should (equal (plist-get config :cwd) "/home/user/project"))
+      (should (equal (plist-get config :args) ["test_foo"])))))
+
+(ert-deftest test-python-dape-last-test-function-switches ()
+  (setq test-cockpit--project-engines nil)
+  (mocker-let
+      ((projectile-project-type () ((:output 'python-pip :occur 1)))
+       (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/home/user/project")))
+       (test-cockpit-python--test-function-path () ((:output "test_foo")))
+       (compile (command) ((:input-matcher (lambda (_) t) :output 'success))))
+    (test-cockpit-test-function '("--verbose" "--capture=no"))
+    (let ((config (test-cockpit--dape-debug-last-test)))
+      (should (equal (plist-get config :cwd) "/home/user/project"))
+      (should (equal (plist-get config :args) ["test_foo" "--verbose" "--capture=no"])))))
+
+
 (ert-deftest test-python-find-test-method-simple ()
   (let ((buffer-contents "
 def test_first_outer():