From 801c05cd80aa41f4d05942a0ac1d372966b4c3d1 Mon Sep 17 00:00:00 2001 From: Johannes Mueller Date: Fri, 31 May 2024 12:58:13 +0200 Subject: [PATCH 1/5] Add stubs for Dape support --- test-cockpit.el | 22 ++++++++++- test/test-cockpit.el-test.el | 73 ++++++++++++++++++++++++++++++++++++ 2 files changed, 93 insertions(+), 2 deletions(-) diff --git a/test-cockpit.el b/test-cockpit.el index 2c34ade..8842849 100644 --- a/test-cockpit.el +++ b/test-cockpit.el @@ -137,6 +137,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 +215,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))) @@ -444,7 +449,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 +459,13 @@ 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) + (when-let + ((config (test-cockpit--dape-debug-last-test))) + (dape config))) (defun test-cockpit--projectile-build (&optional last-cmd) "Launch a projectile driven build process. @@ -522,6 +533,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 +546,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 +558,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)))))))) diff --git a/test/test-cockpit.el-test.el b/test/test-cockpit.el-test.el index d2548a0..2c6ba4c 100644 --- a/test/test-cockpit.el-test.el +++ b/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,16 @@ (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") + (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-main-suffix--all-nil () (tc--register-foo-project "foo") @@ -426,6 +469,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") From 6a8eaa0537f7b8e6b251bc388362ba043fb13f86 Mon Sep 17 00:00:00 2001 From: Johannes Mueller Date: Sat, 1 Jun 2024 12:52:36 +0200 Subject: [PATCH 2/5] Add dape support to python engine --- test-cockpit-python.el | 14 +++++++++++ test/test-python.el-test.el | 50 +++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+) diff --git a/test-cockpit-python.el b/test-cockpit-python.el index d37dea1..d29bd5e 100644 --- a/test-cockpit-python.el +++ b/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 + ('nil []) + ('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) diff --git a/test/test-python.el-test.el b/test/test-python.el-test.el index 1cafc67..2012592 100644 --- a/test/test-python.el-test.el +++ b/test/test-python.el-test.el @@ -146,6 +146,56 @@ (expected (pop struct))) (should (equal (test-cockpit-python--insert-no-coverage-to-switches arglist) expected))))) +(ert-deftest test-python-dape-last-test-project-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 "foo-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(): From b80b0b0ba67b07bfb04811280ccbe4fcde56c394 Mon Sep 17 00:00:00 2001 From: Johannes Mueller Date: Sat, 1 Jun 2024 17:04:38 +0200 Subject: [PATCH 3/5] Throw an error, if no recent test run is available --- test-cockpit-python.el | 2 +- test-cockpit.el | 5 +++-- test/test-cockpit.el-test.el | 2 +- test/test-python.el-test.el | 6 ++++-- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/test-cockpit-python.el b/test-cockpit-python.el index d29bd5e..46e9eb6 100644 --- a/test-cockpit-python.el +++ b/test-cockpit-python.el @@ -45,7 +45,7 @@ (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 - ('nil []) + ('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)))) diff --git a/test-cockpit.el b/test-cockpit.el index 8842849..6560758 100644 --- a/test-cockpit.el +++ b/test-cockpit.el @@ -463,9 +463,10 @@ in order to call the last test action with modified ARGS." (defun test-cockpit-dape-debug-repeat-test () "Repeat the last test action calling the dape debugger, if available." (interactive) - (when-let + (if-let ((config (test-cockpit--dape-debug-last-test))) - (dape config))) + (dape config) + (user-error "No recent test-action has been performed or no Dape support for backend"))) (defun test-cockpit--projectile-build (&optional last-cmd) "Launch a projectile driven build process. diff --git a/test/test-cockpit.el-test.el b/test/test-cockpit.el-test.el index 2c6ba4c..d17a4bf 100644 --- a/test/test-cockpit.el-test.el +++ b/test/test-cockpit.el-test.el @@ -396,7 +396,7 @@ (ert-deftest test-dape-debug-repeat-test--not-available () (tc--register-foo-project "foo") - (test-cockpit-dape-debug-repeat-test)) + (should-error (test-cockpit-dape-debug-repeat-test))) (ert-deftest test-dape-debug-repeat-test--available () (tc--register-dape-project "dape") diff --git a/test/test-python.el-test.el b/test/test-python.el-test.el index 2012592..76e5de4 100644 --- a/test/test-python.el-test.el +++ b/test/test-python.el-test.el @@ -146,11 +146,13 @@ (expected (pop struct))) (should (equal (test-cockpit-python--insert-no-coverage-to-switches arglist) expected))))) -(ert-deftest test-python-dape-last-test-project-no-switches () +(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")))) + (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) From 0ab5d44e22ef9cebbc11680117a9757a84ff3dd4 Mon Sep 17 00:00:00 2001 From: Johannes Mueller Date: Sat, 1 Jun 2024 17:06:08 +0200 Subject: [PATCH 4/5] Mention the experimental Dape support in docs --- README.md | 13 +++++++++++-- test-cockpit.el | 2 ++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 719cf06..407f970 100644 --- a/README.md +++ b/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. diff --git a/test-cockpit.el b/test-cockpit.el index 6560758..b7bec0c 100644 --- a/test-cockpit.el +++ b/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) From e9db93a25025f87884dd3054681d30b990552f7b Mon Sep 17 00:00:00 2001 From: Johannes Mueller Date: Mon, 3 Jun 2024 20:55:15 +0200 Subject: [PATCH 5/5] Make repeat after dape session call dape session again --- test-cockpit.el | 11 +++++++++-- test/test-cockpit.el-test.el | 8 ++++++++ 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/test-cockpit.el b/test-cockpit.el index b7bec0c..19ec4c7 100644 --- a/test-cockpit.el +++ b/test-cockpit.el @@ -397,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 @@ -467,9 +469,14 @@ in order to call the last test action with modified ARGS." (interactive) (if-let ((config (test-cockpit--dape-debug-last-test))) - (dape config) + (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. If last executed command LAST-CMD is given the command is diff --git a/test/test-cockpit.el-test.el b/test/test-cockpit.el-test.el index d17a4bf..2f48743 100644 --- a/test/test-cockpit.el-test.el +++ b/test/test-cockpit.el-test.el @@ -405,6 +405,14 @@ (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") (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))