[elpa] master 45fb7cc 085/215: Add ability to have alternate group location file and line numbers.

[Rocky Bernstein]

branch: master
commit 45fb7cc2873f076d4e2ba66b874a3cafeb4bf203
Author: rocky <address@hidden>
Commit: rocky <address@hidden>

    Add ability to have alternate group location file and line numbers.
    
    This is for perldb's all-over-the place location reporting.
    
    perldb.el: adjust locations for perldb's complicated location
    regexps. Probably broke debug output for older perldb, and probably
    slightly improved it for current perldb.
    
    remove various compiler warnings.
---
 realgud/common/buffer/command.el |    4 ++++
 realgud/common/regexp.el         |    7 +++++--
 realgud/common/send.el           |    1 +
 realgud/common/track.el          |   16 ++++++++++-----
 realgud/debugger/perldb/init.el  |   40 ++++++++++++++++++++++++++++----------
 test/bt-helper.el                |    2 +-
 test/test-common-helper.el       |    3 ++-
 test/test-gdb-core.el            |    6 ++++--
 test/test-loc-regexp-nodejs.el   |    2 +-
 test/test-regexp-gdb.el          |    4 ++--
 test/test-regexp-perldb.el       |   40 ++++++++++++++++++++++++--------------
 11 files changed, 86 insertions(+), 39 deletions(-)

diff --git a/realgud/common/buffer/command.el b/realgud/common/buffer/command.el
index 67eca06..739f72e 100644
--- a/realgud/common/buffer/command.el
+++ b/realgud/common/buffer/command.el
@@ -92,6 +92,8 @@
   loc-regexp   ;; Location regular expression string
   file-group
   line-group
+  alt-file-group
+  alt-line-group
   text-group
   ignore-file-re
 
@@ -296,6 +298,8 @@ values set in the debugger's init.el."
             :loc-regexp (realgud-sget 'loc-pat 'regexp)
             :file-group (realgud-sget 'loc-pat 'file-group)
             :line-group (realgud-sget 'loc-pat 'line-group)
+            :alt-file-group (realgud-sget 'loc-pat 'alt-file-group)
+            :alt-line-group (realgud-sget 'loc-pat 'alt-line-group)
             :text-group (realgud-sget 'loc-pat 'text-group)
             :ignore-file-re (realgud-sget 'loc-pat 'ignore-file-re)
             :loc-hist (make-realgud-loc-hist)
diff --git a/realgud/common/regexp.el b/realgud/common/regexp.el
index 4f7b4da..8dd4fcd 100644
--- a/realgud/common/regexp.el
+++ b/realgud/common/regexp.el
@@ -19,9 +19,9 @@
 (defstruct realgud-loc-pat
   "Information to match and extract position and other related information 
typically
 output by a debugger inside a process shell"
-  (num)                ;; General number, could be for example
+  (num)                ;; General number. Could be for example
                       ;; breakpoint number,
-  (string)             ;; General number, could be for example a list of
+  (string)             ;; General string, Could be for example a list of
                        ;; breakpoint number. Or can be used if for example
                        ;; if we need more than one in a complicated re
                        ;; where we can't assign a single number to a
@@ -29,6 +29,9 @@ 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
+  (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)
diff --git a/realgud/common/send.el b/realgud/common/send.el
index 7fdf561..39ac519 100644
--- a/realgud/common/send.el
+++ b/realgud/common/send.el
@@ -22,6 +22,7 @@
 (require-relative-list '("buffer/helper") "realgud-buffer-")
 
 (declare-function realgud-get-cmdbuf        'realgud-buffer-helper)
+(declare-function realgud-window-cmd-undisturb-src 'realgud-window)
 (declare-function comint-goto-process-mark  'comint)
 (declare-function comint-send-input         'comint)
 (declare-function realgud:canonic-major-mode 'realgud-utils)
diff --git a/realgud/common/track.el b/realgud/common/track.el
index f6dc1f5..feab85a 100644
--- a/realgud/common/track.el
+++ b/realgud/common/track.el
@@ -366,9 +366,11 @@ Otherwise return nil."
 
   ;; NOTE: realgud-cmdbuf-info is a buffer variable local to the process 
running
   ;; the debugger. It contains a realgud-cmdbuf-info "struct". In that struct 
are
-  ;; the fields loc-regexp, file-group, and line-group. By setting the
-  ;; the fields of realgud-cmdbuf-info appropriately we can accomodate a family
-  ;; of debuggers -- one at a time -- for the buffer process.
+  ;; the fields loc-regexp, file-group, line-group, alt-file-group, and 
alt-line-group.
+  ;;
+  ;; By setting the the fields of realgud-cmdbuf-info appropriately, we
+  ;; can accomodate a family of debuggers -- one at a time -- for the
+  ;; buffer process.
 
   (if (realgud-cmdbuf?)
       (let
@@ -378,6 +380,8 @@ Otherwise return nil."
                           (realgud-sget 'cmdbuf-info 'file-group)))
           (line-group (or opt-line-group
                           (realgud-sget 'cmdbuf-info 'line-group)))
+          (alt-file-group (realgud-sget 'cmdbuf-info 'alt-file-group))
+          (alt-line-group (realgud-sget 'cmdbuf-info 'alt-line-group))
           (text-group (realgud-sget 'cmdbuf-info 'text-group))
           (ignore-file-re (or opt-ignore-file-re
                               (realgud-sget 'cmdbuf-info 'ignore-file-re)))
@@ -385,8 +389,10 @@ Otherwise return nil."
           )
        (if loc-regexp
            (if (string-match loc-regexp text)
-               (let* ((filename (match-string file-group text))
-                      (line-str (match-string line-group text))
+               (let* ((filename (or (match-string file-group text)
+                                    (match-string alt-file-group text)))
+                      (line-str (or (match-string line-group text)
+                                    (match-string alt-line-group text)))
                       (source-str (and text-group
                                        (match-string text-group text)))
                       (lineno (string-to-number (or line-str "1"))))
diff --git a/realgud/debugger/perldb/init.el b/realgud/debugger/perldb/init.el
index 08c660f..537703d 100644
--- a/realgud/debugger/perldb/init.el
+++ b/realgud/debugger/perldb/init.el
@@ -17,29 +17,49 @@ realgud-loc-pat struct")
 
 (declare-function make-realgud-loc "realgud-loc" (a b c d e f))
 
-;; Program-location lines look like this:
+;; Program-location lines look like these:
 ;;   File::Basename::dirname(/usr/share/perl/5.16.0/File/Basename.pm:284):
+;;   File::Basename::dirname(/usr/share/perl/5.16.0/File/Basename.pm:284):     
my $path;
 ;;   main::(/usr/bin/latex2html:102):
+;;   main::(/usr/bin/latex2html:102):  @ARGV=2;
 ;;   main::CODE(0x9407ac8)(l2hconf.pm:6):;;
 ;;   main::((eval 8)[/tmp/eval.pl:2]:1):
-;; FIXME:
-;;   the capture for the filename is wrong in eval. I can't figure out
-;;   how to come up with a re that *preserves* file/line groups in the
-;;   capture.
+;;
 ;;   And what are complications MS Windows adds?
-(defconst realgud:perldb-loc-regexp
-  (format 
"\\(?:CODE(0x[0-9a-h]+)\\)?(\\(.+\\):%s):\\(?:\n[0-9]+:\t\\(.*?\\)\n\\)?"
+
+;; Hnadle eval form first, e.g.:
+;;    main::((eval 8)[/tmp/eval.pl:2]:1):
+
+(defconst realgud:perldb-loc-eval-regexp
+  (format "(eval [0-9]+)\\[\\(.+\\):%s\\]"
+         realgud:regexp-captured-num))
+
+;; Hnadle non eval form
+;;    main::CODE(0x9407ac8)(l2hconf.pm:6):;;
+
+(defconst realgud:perldb-loc-noeval-regexp
+  (format "\\(?:CODE(0x[0-9a-h]+)\\)?(\\(.+\\):%s):\\(?:\t\\(.*\\)\\)?\n"
          realgud:regexp-captured-num))
 
+;; Note that eval form has to come before non-eval form as the non-eval
+;; form encompases the eval form. The two clauses makes it hard
+;; to match file and line positions, so we ned to result to the
+;; "alt" forms of file and lines as well as the non-alt formes
+(defconst realgud:perldb-loc-regexp
+  (format "\\(?:%s\\)\\|\\(?:%s\\)"
+         realgud:perldb-loc-eval-regexp realgud:perldb-loc-noeval-regexp))
+
 ;; Regular expression that describes a perldb location generally shown
 ;; before a command prompt. We include matching the source text so we
 ;; can save that.
 (setf (gethash "loc" realgud:perldb-pat-hash)
       (make-realgud-loc-pat
        :regexp realgud:perldb-loc-regexp
-       :file-group 1
-       :line-group 2
-       :text-group 3))
+       :alt-file-group 1
+       :alt-line-group 2
+       :file-group 3
+       :line-group 4
+       :text-group 5))
 
 ;; perldb debugger prompt.
 ;; Examples:
diff --git a/test/bt-helper.el b/test/bt-helper.el
index f003c77..e836b26 100644
--- a/test/bt-helper.el
+++ b/test/bt-helper.el
@@ -37,7 +37,7 @@ for DEBUGGER-NAME and initializes it to STRING"
     (goto-char (point-min))
     (setq buffer-read-only nil)
     (insert string)
-    (font-lock-fontify-buffer)
+    (font-lock-ensure)
     (goto-char (point-min))
     )
   temp-bt
diff --git a/test/test-common-helper.el b/test/test-common-helper.el
index 8b33ab7..31fb652 100644
--- a/test/test-common-helper.el
+++ b/test/test-common-helper.el
@@ -2,13 +2,14 @@
 (load-file "../realgud/common/helper.el")
 
 (declare-function realgud-struct-field-setter 'realgud-helper)
+(declare-function realgud:debugger-name-transform 'realgud-helper)
 (declare-function __FILE__                    'load-relative)
 
+
 (test-simple-start)
 
 (eval-when-compile
   (defvar realgud-test-info)
-  (defvar realgud:debugger-name-transform)
 )
 
 (defstruct realgud-test-info name)
diff --git a/test/test-gdb-core.el b/test/test-gdb-core.el
index c3d2b87..dfc1a1a 100644
--- a/test/test-gdb-core.el
+++ b/test/test-gdb-core.el
@@ -4,10 +4,12 @@
 (require 'test-simple)
 (load-file "../realgud/debugger/gdb/core.el")
 
+(declare-function realgud:gdb-parse-cmd-args 'realgud-gdb-core)
+
 (test-simple-start)
 
 (note "invoke gdb without command line arguments")
-(assert-equal '(("gdb") nil nil nil) 
+(assert-equal '(("gdb") nil nil nil)
              (realgud:gdb-parse-cmd-args
               '("gdb")))
 
@@ -27,7 +29,7 @@
               '("gdb" "--annotate" "1" "-p" "4812")))
 
 (note "invoke gdb with pid")
-(assert-equal '(("gdb" "-p") nil ("4511") nil) 
+(assert-equal '(("gdb" "-p") nil ("4511") nil)
              (realgud:gdb-parse-cmd-args
               '("gdb" "-p" "4511")))
 
diff --git a/test/test-loc-regexp-nodejs.el b/test/test-loc-regexp-nodejs.el
index 42f0ae3..f9b647d 100644
--- a/test/test-loc-regexp-nodejs.el
+++ b/test/test-loc-regexp-nodejs.el
@@ -38,7 +38,7 @@
   (defvar test-dbgr)
   (defvar test-s1)
   (defvar realgud-pat-bt)
-  (defvar realgud:trepanpl-pat-hash)
+  (defvar realgud:nodejs-pat-hash)
 )
 
 ; Some setup usually done in setting up the buffer.
diff --git a/test/test-regexp-gdb.el b/test/test-regexp-gdb.el
index 3c39ded..fcf8fa9 100644
--- a/test/test-regexp-gdb.el
+++ b/test/test-regexp-gdb.el
@@ -12,10 +12,10 @@
 (test-simple-start)
 
 (eval-when-compile
-  (defvar dbg-name)   (defvar realgud-pat-hash)   (defvar realgud-bt-hash)
+  (defvar dbg-name)   (defvar realgud-pat-hash)   (defvar realgud-bt-pat)
   (defvar loc-pat)    (defvar prompt-pat)         (defvar test-s1)
   (defvar file-group) (defvar line-group)         (defvar test-pos)
-  (defvar test-dbgr)  (defvar test-text)
+  (defvar test-dbgr)  (defvar test-text)          (defvar realgud-bt-re)
 )
 
 ; Some setup usually done in setting up the buffer.
diff --git a/test/test-regexp-perldb.el b/test/test-regexp-perldb.el
index fb84ac9..71ac0b6 100644
--- a/test/test-regexp-perldb.el
+++ b/test/test-regexp-perldb.el
@@ -1,9 +1,6 @@
 ;; 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)
 
-;; 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)
 (load-file "../realgud/common/buffer/command.el")
 (load-file "../realgud/lang/perl.el")
@@ -50,6 +47,8 @@
                 :debugger-name dbg-name
                 :loc-regexp (realgud-loc-pat-regexp loc-pat)
                 :file-group (realgud-loc-pat-file-group loc-pat)
+                :alt-line-group (realgud-loc-pat-alt-line-group loc-pat)
+                :alt-file-group (realgud-loc-pat-alt-file-group loc-pat)
                 :line-group (realgud-loc-pat-line-group loc-pat)
                 :text-group (realgud-loc-pat-text-group loc-pat)
                 ))
@@ -58,11 +57,25 @@
 (prompt-match "  DB<2> "  "2")
 (prompt-match "[pid=6489->6502]  DB<1> " "1")
 
+(setq test-text "((eval 1006)[../example/eval.pl:5])")
+(assert-equal 1 (string-match realgud:perldb-loc-eval-regexp
+                             test-text)
+             "perldb eval loc matching")
+
+(assert-equal "../example/eval.pl"
+             (match-string (realgud-cmdbuf-info-alt-file-group test-dbgr)
+                           test-text)
+             "extract file name when we have source text")
+
+(assert-equal "5"
+             (match-string (realgud-cmdbuf-info-alt-line-group test-dbgr)
+                           test-text))
+
 (assert-equal 0 (string-match realgud-perl-ignore-file-re
                              "(eval 1006)[../example/eval.pl:5]")
              "perldb file ignore matching")
 
-(setq test-text "main::(/usr/bin/latex2html:102):")
+(setq test-text "main::(/usr/bin/latex2html:102):\n")
 
 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)) "basic location")
 (assert-equal "/usr/bin/latex2html"
@@ -70,8 +83,7 @@
                            test-text)
              "extract file name")
 
-(setq test-text 
"File::Basename::dirname(/usr/share/perl/5.16.0/File/Basename.pm:284):
-284:       my $path = shift;
+(setq test-text 
"File::Basename::dirname(/usr/share/perl/5.16.0/File/Basename.pm:284): my $path 
= shift;
 ")
 
 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr))
@@ -84,7 +96,7 @@
              (match-string (realgud-cmdbuf-info-line-group test-dbgr)
                            test-text)
              "extract line number when we have source text")
-(assert-equal "    my $path = shift;"
+(assert-equal "my $path = shift;"
              (match-string (realgud-cmdbuf-info-text-group test-dbgr)
                            test-text)
              "extract source text")
@@ -93,19 +105,17 @@
 
 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)) "eval location")
 
-;; FIXME: we should pick out eval.pl
-(assert-equal "(eval 6)[eval.pl:5]"
-             (match-string (realgud-cmdbuf-info-file-group test-dbgr)
+(assert-equal "eval.pl"
+             (match-string (realgud-cmdbuf-info-alt-file-group test-dbgr)
                            test-text)
-             "extract file name")
+             "extract eval file name")
 
-;; FIXME: we should pick out 5, the number in the eval
-(assert-equal "2"
-             (match-string (realgud-cmdbuf-info-line-group test-dbgr)
+(assert-equal "5"
+             (match-string (realgud-cmdbuf-info-alt-line-group test-dbgr)
                            test-text) "extract line number")
 
 (note "location for with CODE in it")
-(setq test-text "main::CODE(0x9407ac8)(l2hconf.pm:6):")
+(setq test-text "main::CODE(0x9407ac8)(l2hconf.pm:6):\n")
 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)))
 (assert-equal "l2hconf.pm"
              (match-string (realgud-cmdbuf-info-file-group test-dbgr)