Debug failing tests

.github/workflows/test.yml

@@ -5,6 +5,7 @@ on:
     branches:
       - master
   pull_request:
+  workflow_dispatch:
 
 jobs:
   test:

dape-tests.el

@@ -48,7 +48,15 @@ failed."
        (with-timeout (,seconds)
          (while (not ,pred)
            (accept-process-output nil 0.01)))
-       (should ,pred)
+       (condition-case err
+         (should ,pred)
+         (ert-test-failed
+          (message "Current buffer: %s" (current-buffer))
+          (message "Current buffer contents:\n%s" (buffer-string))
+          (when-let ((debug-buffer (get-buffer "*dape-debug*")))
+            (with-current-buffer debug-buffer
+              (message "dape-debug contents:\n%s" (buffer-string))))
+          (signal 'ert-test-failed (cdr err))))
        (let ((ret ,pred))
          (ignore ret)
          ret))))
@@ -104,6 +112,9 @@ Helper for `dape-test--with-files'."
         (dape-test--should
          (not (process-list)))
         (advice-remove 'yes-or-no-p 'always-yes)
+        ;; clean up buffers
+        (dolist (buffer buffers)
+          (kill-buffer buffer))
         ;; clean up files
         (delete-directory temp-dir t)))))
 
@@ -198,18 +209,16 @@ Expects line with string \"breakpoint\" in source."
         (dape-breakpoint-toggle)))
     (apply 'dape-test--debug dape-args)
     ;; at breakpoint and stopped
-    (dape-test--should
-     (and (eq dape--state 'stopped)
-          (equal (line-number-at-pos)
-                 (dape-test--line-at-regex "breakpoint"))))
+    (dape-test--should (equal dape--state 'stopped))
+    (dape-test--should (equal (line-number-at-pos)
+                              (dape-test--line-at-regex "breakpoint")))
     ;; restart
     (goto-char (point-min))
     (apply 'dape-test--debug dape-args)
     ;; at breakpoint and stopped
-    (dape-test--should
-     (and (eq dape--state 'stopped)
-          (equal (line-number-at-pos)
-                 (dape-test--line-at-regex "breakpoint"))))))
+    (dape-test--should (eq dape--state 'stopped))
+    (dape-test--should (= (line-number-at-pos)
+                          (dape-test--line-at-regex "breakpoint")))))
 
 (ert-deftest dape-test-restart-with-dape ()
   "Should be able to restart with `dape' even though session active."
@@ -375,29 +384,24 @@ Expects line with string \"breakpoint\" in source."
     ;; contents of watch buffer
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-watch-mode))
-      (dape-test--should
-       (and (dape-test--line-at-regex "^  a")
-            (dape-test--line-at-regex "^\\+ b")))
+      (dape-test--should (dape-test--line-at-regex "^  a"))
+      (dape-test--should (dape-test--line-at-regex "^\\+ b"))
       ;; expansion
       (dape-test--apply-to-match "^\\+ b" 'dape-info-scope-toggle)
       (dape-test--should
        (dape-test--line-at-regex "^    member"))
       ;; assert contraction
       (dape-test--apply-to-match "^\\- b" 'dape-info-scope-toggle)
-      (dape-test--should
-       (not (dape-test--line-at-regex "^    member")))
+      (dape-test--should (not (dape-test--line-at-regex "^    member")))
       ;; set value
-      (dape-test--should
-       (dape-test--line-at-regex "^  a *0"))
+      (dape-test--should (dape-test--line-at-regex "^  a *0"))
       (cl-letf (((symbol-function 'read-string)
                  (lambda (&rest _) "99")))
         (dape-test--apply-to-match "^  a" 'dape-info-variable-edit))
-      (dape-test--should
-       (dape-test--line-at-regex "^  a *99"))
+      (dape-test--should (dape-test--line-at-regex "^  a *99"))
       ;; watch removal
       (dape-test--apply-to-match "^  a" 'dape-info-scope-watch-dwim)
-      (dape-test--should
-       (not (dape-test--line-at-regex "^  a"))))))
+      (dape-test--should (not (dape-test--line-at-regex "^  a"))))))
 
 (ert-deftest dape-test-stack-buffer()
   "Stack buffer contents and commands."
@@ -429,20 +433,18 @@ Expects line with string \"breakpoint\" in source."
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-stack-mode))
       ;; buffer contents
-      (dape-test--should
-       (and (dape-test--line-at-regex "^1 in b")
-            (dape-test--line-at-regex "^2 in a")
-            (member 'dape--info-stack-position
-                    overlay-arrow-variable-list)
-            (= (marker-position dape--info-stack-position) 1)))
+      (dape-test--should (dape-test--line-at-regex "^1 in b"))
+      (dape-test--should (dape-test--line-at-regex "^2 in a"))
+      (dape-test--should (member 'dape--info-stack-position
+                                 overlay-arrow-variable-list))
+      (dape-test--should (= (marker-position dape--info-stack-position) 1))
       ;; select stack frame
       (dape-test--apply-to-match "^2 in a" 'dape-info-stack-select)
       ;; buffer contents
-      (dape-test--should
-       (and (= (marker-position dape--info-stack-position)
-               (save-excursion
-                 (dape-test--goto-line (dape-test--line-at-regex "^2 in a"))
-                 (point))))))
+      (dape-test--should (= (marker-position dape--info-stack-position)
+                            (save-excursion
+                              (dape-test--goto-line (dape-test--line-at-regex "^2 in a"))
+                              (point)))))
     ;; scope buffer should update to new stack
     (with-current-buffer
         (dape-test--should
@@ -451,8 +453,9 @@ Expects line with string \"breakpoint\" in source."
        (dape-test--line-at-regex "^  a_var")))
     ;; source buffer points at new stack frame
     (with-current-buffer main-buffer
-      (= (line-number-at-pos)
-         (dape-test--line-at-regex "stack")))))
+      (dape-test--should
+       (= (line-number-at-pos)
+          (dape-test--line-at-regex "stack"))))))
 
 (ert-deftest dape-test-threads-buffer ()
   "Threads buffer contents and commands."
@@ -485,38 +488,31 @@ Expects line with string \"breakpoint\" in source."
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-threads-mode))
       ;; buffer contents
-      (dape-test--should
-       (and (dape-test--line-at-regex "^1 .* stopped in")
-            (dape-test--line-at-regex "^2 .* stopped in thread_fn")
-            (member 'dape--info-thread-position
-                    overlay-arrow-variable-list)
-            (= (marker-position dape--info-thread-position)
-               (save-excursion
-                 (dape-test--goto-line (dape-test--line-at-regex
-                                        "^2 .* stopped in thread_fn"))
-                 (point))))))
+      (dape-test--should (dape-test--line-at-regex "^1 .* stopped in"))
+      (dape-test--should (dape-test--line-at-regex "^2 .* stopped in thread_fn"))
+      (dape-test--should (member 'dape--info-thread-position overlay-arrow-variable-list))
+      (dape-test--should (= (marker-position dape--info-thread-position)
+                            (save-excursion
+                              (dape-test--goto-line (dape-test--line-at-regex
+                                                     "^2 .* stopped in thread_fn"))
+                              (point)))))
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-scope-mode 0))
       ;; scope buffer in thread_fn
-      (dape-test--should
-       (dape-test--line-at-regex "^  thread_var")))
-    (with-current-buffer (dape-test--should
-                          (dape--info-get-live-buffer 'dape-info-threads-mode))
+      (dape-test--should (dape-test--line-at-regex "^  thread_var")))
+    (with-current-buffer (dape-test--should (dape--info-get-live-buffer 'dape-info-threads-mode))
       ;; select thread
       (dape-test--apply-to-match "^1 .* stopped in" 'dape-info-select-thread))
-    (with-current-buffer (dape-test--should
-                          (dape--info-get-live-buffer 'dape-info-threads-mode))
+    (with-current-buffer (dape-test--should (dape--info-get-live-buffer 'dape-info-threads-mode))
       ;; thread selected
-      (dape-test--should
-       (and (dape-test--line-at-regex "^1 .* stopped in")
-            (dape-test--line-at-regex "^2 .* stopped in thread_fn")
-            (member 'dape--info-thread-position
-                    overlay-arrow-variable-list)
-            (= (marker-position dape--info-thread-position)
-               (save-excursion
-                 (dape-test--goto-line (dape-test--line-at-regex
-                                        "^1 .* stopped in"))
-                 (point))))))
+      (dape-test--should (dape-test--line-at-regex "^1 .* stopped in"))
+      (dape-test--should (dape-test--line-at-regex "^2 .* stopped in thread_fn"))
+      (dape-test--should (member 'dape--info-thread-position overlay-arrow-variable-list))
+      (dape-test--should (= (marker-position dape--info-thread-position)
+                            (save-excursion
+                              (dape-test--goto-line (dape-test--line-at-regex
+                                                     "^1 .* stopped in"))
+                              (point)))))
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-scope-mode 0))
       ;; scope buffer in thread_fn
@@ -541,29 +537,25 @@ Expects line with string \"breakpoint\" in source."
     (dape-test--debug 'debugpy
                       :program (buffer-file-name main-buffer)
                       :cwd default-directory)
+
     ;; at breakpoint and stopped
-    (dape-test--should
-     (eq dape--state 'stopped))
     (with-current-buffer main-buffer
-      (dape-test--should
-       (and (= (line-number-at-pos)
-               (dape-test--line-at-regex "breakpoint"))
-            (eq dape--state 'stopped))))
+      (dape-test--should (= (line-number-at-pos)
+                            (dape-test--line-at-regex "breakpoint"))))
+    (dape-test--should (dape--stopped-threads))
+    (dape-test--should (get-buffer "*dape-repl*"))
     (pop-to-buffer "*dape-repl*")
     (insert "next")
     (comint-send-input)
     (with-current-buffer main-buffer
-      (dape-test--should
-       (and (= (line-number-at-pos)
-               (dape-test--line-at-regex "second line"))
-            (eq dape--state 'stopped))))
+      (dape-test--should (= (line-number-at-pos)
+                            (dape-test--line-at-regex "second line"))))
+    (dape-test--should (eq dape--state 'stopped))
     (insert "next")
     (comint-send-input)
+    (dape-test--should (dape--stopped-threads))
     (with-current-buffer main-buffer
-      (dape-test--should
-       (and (= (line-number-at-pos)
-               (dape-test--line-at-regex "third line"))
-            (eq dape--state 'stopped))))
+      (dape-test--should (= (line-number-at-pos) (dape-test--line-at-regex "third line"))))
     (insert "a = 99")
     (comint-send-input)
     (with-current-buffer (dape-test--should
@@ -588,14 +580,12 @@ Expects line with string \"breakpoint\" in source."
                       :program (buffer-file-name main-buffer)
                       :cwd default-directory)
     ;; at breakpoint and stopped
-    (dape-test--should
-     (eq dape--state 'stopped))
+    (dape-test--should (eq dape--state 'stopped))
     (dape--info-buffer 'dape-info-modules-mode)
     ;; contents
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-modules-mode))
-      (dape-test--should
-       (dape-test--line-at-regex "^__main__ of main.py")))))
+      (dape-test--should (dape-test--line-at-regex "^__main__ of main.py")))))
 
 (ert-deftest dape-test-sources-buffer ()
   "Sources buffer contents and commands."
@@ -615,15 +605,13 @@ Expects line with string \"breakpoint\" in source."
                       :program (buffer-file-name index-buffer)
                       :cwd default-directory)
     ;; stopped
-    (dape-test--should
-     (eq dape--state 'stopped))
+    (dape-test--should (eq dape--state 'stopped))
     (dape--info-buffer 'dape-info-sources-mode)
     ;; contents
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-sources-mode))
-      (dape-test--should
-       (and (dape-test--line-at-regex "^os ")
-            (dape-test--line-at-regex "index.js"))))
+      (dape-test--should (dape-test--line-at-regex "^os "))
+      (dape-test--should (dape-test--line-at-regex "index.js")))
     (with-current-buffer (dape-test--should
                           (dape--info-get-live-buffer 'dape-info-sources-mode))
       (dape-test--apply-to-match "^os " 'dape-info-sources-goto))

dape.el

@@ -862,10 +862,10 @@ If EXTENDED end of line is after newline."
   (ignore-errors
     (and dape--process
          (delete-process dape--process))
-    (and dape--server-process
-         (delete-process dape--server-process))
     (and dape--parent-process
-         (delete-process dape--parent-process))))
+         (delete-process dape--parent-process))
+    (and dape--server-process
+         (delete-process dape--server-process))))
 
 (defun dape--kill-buffers (&optional skip-process-buffers)
   "Kill all Dape related buffers.
@@ -1483,6 +1483,10 @@ Starts a new process to run process to be debugged."
   "Handle startDebugging requests.
 Starts a new process as per request of the debug adapter."
   (dape--response process (symbol-name command) seq t)
+  (when (process-live-p dape--parent-process)
+    ;; If an adapter spawns multiple child process warn
+    ;; TODO this should be supported but is jsonrpc is needed as an first step
+    (dape--debug 'error "Multiple parent process"))
   (setq dape--parent-process dape--process)
   ;; js-vscode leaves launch request un-answered
   (when (hash-table-p dape--timers)
@@ -1625,13 +1629,19 @@ Starts a new process as per request of the debug adapter."
                           'dape-repl-exit-code-exit
                         'dape-repl-exit-code-fail)))
 
-(cl-defmethod dape-handle-event (_process (_event (eql terminated)) _body)
+(cl-defmethod dape-handle-event (process (_event (eql terminated)) body)
   "Handle terminated events."
-  (dape--update-state 'terminated)
-  (dape--remove-stack-pointers)
-  (dape--repl-message "* Program terminated *" 'italic)
-  (unless dape--restart-in-progress
-    (dape-kill)))
+  (if (and (process-live-p dape--parent-process)
+           (not (eq process dape--parent-process)))
+      (dape-handle-event dape--parent-process 'terminated body)
+    (dape--update-state 'terminated)
+    (dape--remove-stack-pointers)
+    (dape--repl-message "* Program terminated *" 'italic)
+    (unless (or dape--restart-in-progress
+                (eq (plist-get body :restart) t)
+                (or (eq dape--process process)
+                    (eq dape--parent-process process)))
+      (dape-kill))))
 
 
 ;;; Startup/Setup