[elpa] externals/realgud 4548392 100/140: Add alternate breakpoint match regexp...

[Rocky Bernstein]

branch: externals/realgud
commit 4548392392d0dd9ae24a46de532b9409ebe286a2
Author: rocky <address@hidden>
Commit: rocky <address@hidden>

    Add alternate breakpoint match regexp...
    
    allow regexp lists at least for breakpoint adding
---
 realgud/common/regexp.el     |   7 ++-
 realgud/common/track.el      |  36 +++++++++------
 realgud/debugger/gdb/init.el |  21 ++++++---
 test/regexp-helper.el        |  17 +++++--
 test/test-loc-regexp-gdb.el  | 106 +++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 162 insertions(+), 25 deletions(-)

diff --git a/realgud/common/regexp.el b/realgud/common/regexp.el
index e21de25..4cdbbff 100644
--- a/realgud/common/regexp.el
+++ b/realgud/common/regexp.el
@@ -42,9 +42,13 @@ output by a debugger inside a process shell"
   (regexp)             ;; a stack position, or thread number.
   (file-group)         ;; Filename position in struct
   (line-group)         ;; Line number position in struct
+
+  ;; FIXME: fix code to handle lists of locs and then remove
   (alt-file-group)     ;; Used when regexp is too complicated and use \|
                        ;; e.g. perldb file loc regexps
   (alt-line-group)     ;; ditto
+
+
   (char-offset-group)  ;; Character offset position in struct
   (instruction-address-group)
   (column-group)
@@ -53,7 +57,8 @@ output by a debugger inside a process shell"
   (text-group)         ;; Some source text that should found at position
   (class-group)        ;; Java doesn't refer to files, but class names
   (event-group)        ;; Stopping event, e.g.statement, breakpoint,
-                      ;; call, return, exception, etc.
+                       ;; call, return, exception, etc.
+  (function-group)     ;; function name
 )
 
 (defconst realgud:regexp-captured-num  "\\([0-9]+\\)")
diff --git a/realgud/common/track.el b/realgud/common/track.el
index a0de3f1..db808ff 100644
--- a/realgud/common/track.el
+++ b/realgud/common/track.el
@@ -507,9 +507,15 @@ Otherwise return nil. CMD-MARK is set in the realgud-loc 
object created.
   (with-current-buffer cmdbuf
     (unless (realgud:track-complain-if-not-in-cmd-buffer cmdbuf t)
       (let* ((loc-pat (realgud-cmdbuf-pat "brkpt-set"))
-            (shortkey-mode? (realgud-sget 'cmdbuf-info 'src-shortkey?)))
-       (if loc-pat
-           (let ((bp-num-group   (realgud-loc-pat-num loc-pat))
+            (shortkey-mode? (realgud-sget 'cmdbuf-info 'src-shortkey?))
+            (found-loc nil)
+            (loc-pat-list loc-pat))
+       (unless (listp loc-pat-list)
+         (setq loc-pat-list (list loc-pat)))
+       (while loc-pat-list
+         (setq loc-pat (car loc-pat-list))
+         (setq loc-pat-list (cdr loc-pat-list))
+         (let ((bp-num-group   (realgud-loc-pat-num loc-pat))
                  (loc-regexp     (realgud-loc-pat-regexp loc-pat))
                  (file-group     (realgud-loc-pat-file-group loc-pat))
                  (line-group     (realgud-loc-pat-line-group loc-pat))
@@ -527,9 +533,10 @@ Otherwise return nil. CMD-MARK is set in the realgud-loc 
object created.
                             (lineno (string-to-number (or line-str "1")))
                             )
                        (cond (callback-loc-fn
-                              (funcall callback-loc-fn text
-                                       filename lineno source-str
-                                       ignore-re-file-list cmd-mark))
+                              (setq found-func (funcall callback-loc-fn text
+                                                        filename lineno 
source-str
+                                                        ignore-re-file-list 
cmd-mark))
+                              (setq loc-pat-list nil))
 
                              ('t
                               (unless line-str
@@ -551,7 +558,8 @@ Otherwise return nil. CMD-MARK is set in the realgud-loc 
object created.
                                         (progn
                                           (message loc-or-error)
                                           ;; set to return nil
-                                          nil)
+                                          (setq found-loc nil)
+                                          (setq loc-pat-list nil))
                                       ;; else
                                       (let ((loc loc-or-error)
                                             (bp-list (realgud-sget 
'cmdbuf-info 'bp-list)))
@@ -573,13 +581,13 @@ Otherwise return nil. CMD-MARK is set in the realgud-loc 
object created.
                                           (realgud-cmdbuf-info-bp-list= (cons 
loc bp-list)))
 
                                         ;; Set to return location
-                                        loc-or-error))))
-                              nil))))
-               nil))
-         nil))
-      )
-    )
-  )
+                                        (setq found-loc loc-or-error)
+                                        (setq loc-pat-list nil))
+                                      )))
+                              )))
+                   ))))
+       found-loc)
+    )))
 
 (defun realgud-track-bp-delete(text &optional cmd-mark cmdbuf 
ignore-re-file-list)
   "Do regular-expression matching to see if a breakpoint has been
diff --git a/realgud/debugger/gdb/init.el b/realgud/debugger/gdb/init.el
index e2c4a80..0667aa2 100644
--- a/realgud/debugger/gdb/init.el
+++ b/realgud/debugger/gdb/init.el
@@ -59,12 +59,21 @@ realgud-loc-pat struct")
 ;; For example:
 ;;   Breakpoint 1, main (argc=1, argv=0x7fffffffdbd8) at main.c:24
 (setf (gethash "brkpt-set" realgud:gdb-pat-hash)
-      (make-realgud-loc-pat
-       :regexp (format "^Breakpoint %s at 0x\\([0-9a-f]*\\): file \\(.+\\), 
line %s.\n"
-                      realgud:regexp-captured-num realgud:regexp-captured-num)
-       :num 1
-       :file-group 3
-       :line-group 4))
+      (list
+       (make-realgud-loc-pat
+       :regexp (format "^Breakpoint %s at 0x\\([0-9a-f]*\\): file \\(.+\\), 
line %s[.]\n"
+                       realgud:regexp-captured-num realgud:regexp-captured-num)
+       :num 1
+       :file-group 3
+       :line-group 4)
+       ;; Another breakpoint pattern seen
+       (make-realgud-loc-pat
+       :regexp (format "^Breakpoint %s, .* at \\(.+\\):%s[.]\n"
+                       realgud:regexp-captured-num realgud:regexp-captured-num)
+       :num 1
+       :file-group 2
+       :line-group 3)
+       ))
 
 ;; Regular expression that describes a debugger "delete" (breakpoint)
 ;; response.
diff --git a/test/regexp-helper.el b/test/regexp-helper.el
index 01dc7d2..76b18f0 100644
--- a/test/regexp-helper.el
+++ b/test/regexp-helper.el
@@ -19,10 +19,19 @@
   (setq helper-tb     (gethash "lang-backtrace" pat-hash))
 )
 
-(defun loc-match(text var)
-  "Match TEXT against regexp field VAR"
-  (string-match (realgud-loc-pat-regexp var) text)
-)
+(defun loc-match(text regexp-list)
+  "Match TEXT against regexp field REGEXP"
+  (let ((regexp)
+       (ret-val nil))
+    (unless (listp regexp-list)
+      (setq regexp-list (list regexp-list)))
+    (while regexp-list
+      (setq regexp (car regexp-list))
+      (setq regexp-list (cdr regexp-list))
+      (when (setq ret-val (string-match (realgud-loc-pat-regexp regexp) text))
+       (setq regexp-list nil)))
+    ret-val
+    ))
 
 (defun bp-loc-match(text)
   (string-match (realgud-loc-pat-regexp helper-bps) text)
diff --git a/test/test-loc-regexp-gdb.el b/test/test-loc-regexp-gdb.el
new file mode 100644
index 0000000..abde2a5
--- /dev/null
+++ b/test/test-loc-regexp-gdb.el
@@ -0,0 +1,106 @@
+;; Press C-x C-e at the end of the next line to run this file test 
non-interactively
+;; (test-simple-run "emacs -batch -L %s -l %s" (file-name-directory 
(locate-library "test-simple.elc")) buffer-file-name)
+
+(require 'test-simple)
+(require 'load-relative)
+(load-file "./regexp-helper.el")
+(load-file "../realgud/common/regexp.el")
+(load-file "../realgud/debugger/gdb/init.el")
+
+(declare-function realgud-cmdbuf-info-loc-regexp 'realgud-buffer-command)
+(declare-function cmdbuf-loc-match               'realgud-regexp)
+(declare-function realgud-loc-pat-regexp         'realgud-regexp)
+(declare-function realgud-loc-pat-file-group     'realgud-regexp)
+(declare-function realgud-loc-pat-line-group     'realgud-regexp)
+(declare-function realgud-cmdbuf-info-file-group 'realgud-regexp)
+(declare-function realgud-cmdbuf-info-line-group 'realgud-regexp)
+(declare-function realgud-cmdbuf-info            'realgud-regexp)
+(declare-function make-realgud-cmdbuf-info       'realgud-regexp)
+(declare-function __FILE__                       'load-relative)
+
+(test-simple-start)
+
+(eval-when-compile
+  (defvar dbg-name)
+  (defvar realgud-pat-hash)
+  (defvar helper-bps)
+  (defvar loc-pat)
+  (defvar prompt-pat)
+  (defvar realgud:gdb-pat-hash)
+  (defvar test-dbgr)
+  (defvar test-s1)
+  (defvar test-text)
+)
+
+(note "prompt matching")
+
+(set (make-local-variable 'prompt-pat)
+     (gethash "prompt" realgud:gdb-pat-hash))
+
+(prompt-match "(gdb) ")
+
+(setup-regexp-vars realgud:gdb-pat-hash)
+
+;; Some setup usually done in setting up the buffer.
+;; We customize this for the debugger trepan. Others may follow.
+;; FIXME: encapsulate this.
+(setq dbg-name "gdb")
+(setq loc-pat (gethash "loc" (gethash dbg-name realgud-pat-hash)))
+
+(setq test-dbgr (make-realgud-cmdbuf-info
+                :debugger-name dbg-name
+                :loc-regexp (realgud-loc-pat-regexp loc-pat)
+                :file-group (realgud-loc-pat-file-group loc-pat)
+                :line-group (realgud-loc-pat-line-group loc-pat)))
+
+
+(setq test-text "/tmp/Porosity.cpp:229:8538:beg:0x555555588d48")
+(assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)) "basic location")
+
+(note "extract file name")
+(assert-equal 0 (cmdbuf-loc-match test-text test-dbgr))
+(assert-equal "/tmp/Porosity.cpp"
+             (match-string (realgud-cmdbuf-info-file-group test-dbgr)
+                           test-text))
+
+(assert-equal "229"
+             (match-string
+              (realgud-cmdbuf-info-line-group test-dbgr)
+              test-text) "extract line number")
+
+(note "breakpoint location matching")
+
+(setq test-s1
+      "Breakpoint 4 at 0x34cc3: file Porosity.cpp, line 226.\n")
+
+(assert-t (numberp (loc-match test-s1 helper-bps))
+         "basic breakpoint location")
+(assert-equal "4"
+             (match-string (realgud-loc-pat-num (car helper-bps))
+                           test-s1)   "extract breakpoint number")
+(assert-equal "Porosity.cpp"
+             (match-string (realgud-loc-pat-file-group (car helper-bps))
+                           test-s1)   "extract breakpoint file name")
+(assert-equal "226"
+             (match-string (realgud-loc-pat-line-group (car helper-bps))
+                           test-s1)
+             "extract breakpoint line number")
+
+
+(setq test-s1
+      "Breakpoint 10, main (argc=3, argv=0x7fffffffe738) at 
Porosity2.cpp:22.\n")
+
+(assert-t (numberp (loc-match test-s1 helper-bps))
+         "basic breakpoint location")
+
+(assert-equal "10"
+             (match-string 1 test-s1)   "extract breakpoint number")
+
+(assert-equal "Porosity2.cpp"
+             (match-string 2 test-s1)   "extract breakpoint file name")
+(assert-equal "22"
+             (match-string 3  test-s1)
+             "extract breakpoint line number")
+
+
+(end-tests)