]> code.delx.au - gnu-emacs-elpa/commitdiff
Create common Perl language file. Add pattern for Perl error message.
authorrocky <rocky@gnu.org>
Sun, 23 Oct 2011 14:55:57 +0000 (10:55 -0400)
committerrocky <rocky@gnu.org>
Sun, 23 Oct 2011 14:55:57 +0000 (10:55 -0400)
dbgr/debugger/perldb/init.el
dbgr/debugger/perldb/track-mode.el
dbgr/debugger/trepanpl/init.el
dbgr/debugger/trepanpl/track-mode.el
dbgr/lang/perl.el [new file with mode: 0644]
test/test-regexp-perldb.el

index 26b99fc713e066604d911c5ea3234173395bdce3..412ff75f7def37c71764ea23607916481f619322 100644 (file)
@@ -5,6 +5,7 @@
 
 (require 'load-relative)
 (require-relative-list '("../regexp" "../loc") "dbgr-")
+(require-relative-list '("../../lang/perl") "dbgr-lang-")
 
 (defvar dbgr-pat-hash)
 (declare-function make-dbgr-loc-pat (dbgr-loc))
@@ -50,19 +51,16 @@ dbgr-loc-pat struct")
        :file-group 1
        :line-group 2))
 
+;;  Regular expression that describes location in a Perl errmsg
+(setf (gethash "perl-errmsg" dbgr-perldb-pat-hash) 
+      dbgr-perl-errmsg-loc-pat)
+
 ;;  Regular expression that describes a Perl Carp backtrace line.
 ;;  at /tmp/foo.pl line 7
 ;;     main::__ANON__('Illegal division by zero at /tmp/foo.pl line 4.\x{a}') called at /tmp/foo.pl line 4
 ;;     main::foo(3) called at /tmp/foo.pl line 8
-2
-(setf (gethash "lang-backtrace" dbgr-perldb-pat-hash)
-      (make-dbgr-loc-pat
-       :regexp   (concat 
-                 "\\(?:^\\|
-\\)"
-                 "\\(?:[ \t]+\\(?:\\|.* called \\)at \\(.*\\) line \\([0-9]+\\)\\)")
-       :file-group 1
-       :line-group 2))
+(setf (gethash "lang-backtrace" dbgr-perldb-pat-hash) 
+      dbgr-perl-carp-loc-pat)
 
 (defvar dbgr-perldb-command-hash (make-hash-table :test 'equal)
   "Hash key is command name like 'quit' and the value is 
index e18f3ddfd80b7198d68a9551d9a18edf40fd7a2e..3f396e556cecd791242740b8d137af996e3a4a98 100644 (file)
 (dbgr-track-mode-vars "dbgr-perldb")
 
 (declare-function dbgr-track-mode(bool))
-
-(define-key dbgr-perldb-track-mode-map 
-  (kbd "C-c !!") 'dbgr-goto-lang-backtrace-line)
-(define-key dbgr-perldb-track-mode-map 
-  (kbd "C-c !b") 'dbgr-goto-debugger-backtrace-line)
+(dbgr-perl-populate-command-keys dbgr-perldb-track-mode-map )
 
 ;; Perldb doesn't have stack switching commands.
 (define-key dbgr-perldb-short-key-mode-map
index 9af5366756df500d69f1ae76b1b947a3f3ff9d77..757dd1d34691c724b7e015daf16d72aa11f76c42 100644 (file)
@@ -7,6 +7,7 @@
                         "../../common/loc" 
                         "../../common/init") 
                       "dbgr-")
+(require-relative-list '("../../lang/perl") "dbgr-lang-")
 
 (defvar dbgr-pat-hash)
 (declare-function make-dbgr-loc-pat (dbgr-loc))
@@ -38,18 +39,27 @@ dbgr-loc-pat struct")
        :regexp "^(+trepanpl\\(@[0-9]+\\|@main\\)?)+: "
        ))
 
-;; Regular expression that describes a Ruby YARV 1.9 backtrace line.
+;; Regular expression that describes a Perl backtrace line.
 ;; For example:
-;; <internal:lib/rubygems/custom_require>:29:in `require'
-;; <internal:lib/rubygems/custom_require>:29:in `require'
-;; /tmp/Rakefile:50:in `<top /src/external-vcs/laser/Rakefile>'
-;;     from /usr/lib/ruby/gems/rspec/compatibility.pl:6:in `const_missing'
-(setf (gethash "lang-backtrace" dbgr-trepanpl-pat-hash)
+;; $ = main::top_navigation_panel called from file `./latex2html' line 7400
+;; $ = main::BEGIN() called from file `(eval 19)[/usr/bin/latex2html:126]' line 2
+(setf (gethash "debugger-backtrace" dbgr-trepanpl-pat-hash)
   (make-dbgr-loc-pat
    :regexp "^\\(?:[\t]from \\)?\\([^:]+\\):\\([0-9]+\\)\\(?:in `.*'\\)?"
    :file-group 1
    :line-group 2))
 
+;;  Regular expression that describes location in a Perl errmsg
+(setf (gethash "perl-errmsg" dbgr-trepanpl-pat-hash) 
+      dbgr-perl-errmsg-loc-pat)
+
+;;  Regular expression that describes a Perl Carp backtrace line.
+;;  at /tmp/foo.pl line 7
+;;     main::__ANON__('Illegal division by zero at /tmp/foo.pl line 4.\x{a}') called at /tmp/foo.pl line 4
+;;     main::foo(3) called at /tmp/foo.pl line 8
+(setf (gethash "lang-backtrace" dbgr-trepanpl-pat-hash) 
+      dbgr-perl-carp-loc-pat)
+
 ;; Regular expression that describes a "breakpoint set" line. 
 ;; For example: 
 ;;   Breakpoint 1 set at VM offset 2 of instruction sequence "require",
index 43305d1e34d9016bd7e3331bab3f4aeac72e1b24..80dccbfe8115812009a1ea6da62763098cdbc041 100644 (file)
@@ -25,6 +25,8 @@ described by PT."
 (define-key dbgr-trepanpl-track-mode-map 
   (kbd "C-c !s") 'dbgr-trepanpl-goto-syntax-error-line)
 
+(dbgr-perl-populate-command-keys dbgr-trepanpl-track-mode-map)
+
 (defun dbgr-trepanpl-track-mode-hook()
   (if dbgr-trepanpl-track-mode
       (progn
diff --git a/dbgr/lang/perl.el b/dbgr/lang/perl.el
new file mode 100644 (file)
index 0000000..c518d3d
--- /dev/null
@@ -0,0 +1,48 @@
+;;; Copyright (C) 2011 Rocky Bernstein <rocky@gnu.org>
+;;; Common Perl constants and regular expressions.
+(eval-when-compile (require 'cl))
+
+(require 'load-relative)
+(require-relative-list '("../common/regexp" "../common/loc" "../common/track") 
+                      "dbgr-")
+
+
+;;  Regular expression that describes a Perl Carp backtrace line.
+;;  at /tmp/foo.pl line 7
+;;     main::__ANON__('Illegal division by zero at /tmp/foo.pl line 4.\x{a}') called at /tmp/foo.pl line 4
+;;     main::foo(3) called at /tmp/foo.pl line 8
+(defconst dbgr-perl-carp-loc-pat
+      (make-dbgr-loc-pat
+       :regexp   (concat 
+                 "\\(?:^\\|
+\\)"
+                 "\\(?:[ \t]+\\(?:\\|.* called \\)at \\(.*\\) line \\([0-9]+\\)\\)")
+       :file-group 1
+       :line-group 2)
+  "A dbgr-loc-pat struct that describes a line used in a Carp message"  )
+
+(defconst dbgr-perl-errmsg-loc-pat
+      (make-dbgr-loc-pat
+       :regexp   (concat 
+                 " at \\(.+\\) line \\([0-9]+\\).$")
+       :file-group 1
+       :line-group 2)
+  "A dbgr-loc-pat struct that describes a line used in an error message"  )
+
+;; FIXME: there is probably a less redundant way to do the following
+;; FNS. 
+(defun dbgr-perl-goto-errmsg-line (pt)
+  "Display the location mentioned by the Perl error message described by PT."
+  (interactive "d")
+  (dbgr-goto-line-for-pt pt "perl-errmsg"))
+
+(defun dbgr-perl-populate-command-keys (&optional map)
+  "Bind the debugger function key layout used by many debuggers.
+
+\\{dbgr-example-map-standard}"
+  (define-key map (kbd "C-c !b") 'dbgr-goto-debugger-backtrace-line)
+  (define-key map (kbd "C-c !!") 'dbgr-goto-lang-backtrace-line)
+  (define-key map (kbd "C-c !e") 'dbgr-perl-goto-errmsg-line)
+  )
+
+(provide-me "dbgr-lang-")
index 827fe8a3ae22db26f21931d3bcbfd8f40338216d..4e6bb14238003ee6c08f7d31ceaf692b142f23ca 100644 (file)
@@ -66,7 +66,7 @@
                                             dbgr-perldb-pat-hash))
                  (setq s1
                        "$ = main::top_navigation_panel called from file `./latex2html' line 7400
-")
+p")
                  (setq dbgr-bt-re (dbgr-loc-pat-regexp dbgr-bt-pat))
                  (setq file-group (dbgr-loc-pat-file-group dbgr-bt-pat))
                  (setq line-group (dbgr-loc-pat-line-group dbgr-bt-pat))
                                           (match-end line-group)))
                  )
 
+        (specify "debugger-errmsg"
+                 (setq dbgr-bt-pat  (gethash "perl-errmsg"  
+                                            dbgr-perldb-pat-hash))
+                 (setq s1
+                       "Use of uninitialized value $lines[0] in join or string at bin/../lib/LineCache.pm line 548.")
+                 (setq dbgr-bt-re (dbgr-loc-pat-regexp dbgr-bt-pat))
+                 (setq file-group (dbgr-loc-pat-file-group dbgr-bt-pat))
+                 (setq line-group (dbgr-loc-pat-line-group dbgr-bt-pat))
+                 (assert-equal 54 (string-match dbgr-bt-re s1))
+                 (assert-equal "bin/../lib/LineCache.pm"
+                               (substring s1 
+                                          (match-beginning file-group)
+                                          (match-end file-group)))
+                 (assert-equal "548"
+                               (substring s1 
+                                          (match-beginning line-group)
+                                          (match-end line-group)))
+                 )
+
         (specify "carp-backtrace"
                  (setq s1
                        " at /tmp/foo.pl line 7