2 (load-file "../realgud/common/buffer/command.el")
3 (load-file "../realgud/lang/perl.el")
4 (load-file "../realgud/debugger/perldb/init.el")
5 (load-file "./regexp-helper.el")
7 (declare-function __FILE__ 'load-relative)
8 (declare-function prompt-match 'regexp-helper)
9 (declare-function cmdbuf-loc-match 'realgud-regexp)
15 (defvar realgud:perldb-pat-hash)
16 (defvar realgud-pat-hash)
28 (defvar realgud-bt-pat)
29 (defvar realgud-bt-re)
31 (defvar realgud-perl-ignore-file-re)
34 ; Some setup usually done in setting up the buffer.
35 ; We customize this for this debugger.
36 ; FIXME: encapsulate this.
37 (setq dbg-name "perldb")
38 (set (make-local-variable 'loc-pat)
39 (gethash "loc" (gethash dbg-name realgud-pat-hash)))
40 (set (make-local-variable 'prompt-pat)
41 (gethash "prompt" realgud:perldb-pat-hash))
43 (setq test-dbgr (make-realgud-cmdbuf-info
44 :debugger-name dbg-name
45 :loc-regexp (realgud-loc-pat-regexp loc-pat)
46 :file-group (realgud-loc-pat-file-group loc-pat)
47 :line-group (realgud-loc-pat-line-group loc-pat)
48 :text-group (realgud-loc-pat-text-group loc-pat)
52 (prompt-match " DB<2> " "2")
53 (prompt-match "[pid=6489->6502] DB<1> " "1")
55 (assert-equal 0 (string-match realgud-perl-ignore-file-re
56 "(eval 1006)[../example/eval.pl:5]")
57 "perldb file ignore matching")
59 (setq test-text "main::(/usr/bin/latex2html:102):")
61 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)) "basic location")
62 (assert-equal "/usr/bin/latex2html"
63 (match-string (realgud-cmdbuf-info-file-group test-dbgr)
67 (setq test-text "File::Basename::dirname(/usr/share/perl/5.16.0/File/Basename.pm:284):
68 284: my $path = shift;
71 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr))
72 "location with source")
73 (assert-equal "/usr/share/perl/5.16.0/File/Basename.pm"
74 (match-string (realgud-cmdbuf-info-file-group test-dbgr)
76 "extract file name when we have source text")
78 (match-string (realgud-cmdbuf-info-line-group test-dbgr)
80 "extract line number when we have source text")
81 (assert-equal " my $path = shift;"
82 (match-string (realgud-cmdbuf-info-text-group test-dbgr)
84 "extract source text")
86 (setq test-text "main::((eval 6)[eval.pl:5]:2): $x = 2;")
88 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)) "eval location")
89 (assert-equal "(eval 6)[eval.pl:5]"
90 (match-string (realgud-cmdbuf-info-file-group test-dbgr)
95 (match-string (realgud-cmdbuf-info-line-group test-dbgr)
96 test-text) "extract line number")
98 (note "location for with CODE in it")
99 (setq test-text "main::CODE(0x9407ac8)(l2hconf.pm:6):")
100 (assert-t (numberp (cmdbuf-loc-match test-text test-dbgr)))
101 (assert-equal "l2hconf.pm"
102 (match-string (realgud-cmdbuf-info-file-group test-dbgr)
105 (match-string (realgud-cmdbuf-info-line-group test-dbgr)
108 (note "debugger-backtrace")
109 (setq realgud-bt-pat (gethash "debugger-backtrace"
110 realgud:perldb-pat-hash))
112 "$ = main::top_navigation_panel called from file `./latex2html' line 7400
114 (setq realgud-bt-re (realgud-loc-pat-regexp realgud-bt-pat))
115 (setq file-group (realgud-loc-pat-file-group realgud-bt-pat))
116 (setq line-group (realgud-loc-pat-line-group realgud-bt-pat))
117 (assert-equal 30 (string-match realgud-bt-re test-s1))
118 (assert-equal "./latex2html"
120 (match-beginning file-group)
121 (match-end file-group)))
124 (match-beginning line-group)
125 (match-end line-group)))
127 (note "debugger-errmsg")
128 (setq realgud-bt-pat (gethash "perl-errmsg"
129 realgud:perldb-pat-hash))
131 "Use of uninitialized value $lines[0] in join or string at bin/../lib/LineCache.pm line 548.")
132 (setq realgud-bt-re (realgud-loc-pat-regexp realgud-bt-pat))
133 (setq file-group (realgud-loc-pat-file-group realgud-bt-pat))
134 (setq line-group (realgud-loc-pat-line-group realgud-bt-pat))
135 (assert-equal 54 (string-match realgud-bt-re test-s1))
136 (assert-equal "bin/../lib/LineCache.pm"
138 (match-beginning file-group)
139 (match-end file-group)))
142 (match-beginning line-group)
143 (match-end line-group)))
145 (note "carp-backtrace")
147 " at /tmp/foo.pl line 7
148 main::__ANON__('Illegal division by zero at /tmp/foo.pl line 4.\x{a}') called at foo2.pl line 5
149 main::foo(3) called at foo3.pl line 8
151 (setq lang-bt-pat (gethash "lang-backtrace"
152 realgud:perldb-pat-hash))
153 (setq carp-bt-re (realgud-loc-pat-regexp lang-bt-pat))
154 (setq file-group (realgud-loc-pat-file-group lang-bt-pat))
155 (setq line-group (realgud-loc-pat-line-group lang-bt-pat))
156 (assert-equal 0 (string-match carp-bt-re test-s1))
157 (assert-equal "/tmp/foo.pl"
159 (match-beginning file-group)
160 (match-end file-group)))
163 (match-beginning line-group)
164 (match-end line-group)))
165 (setq test-pos (match-end 0))
167 (assert-equal 22 (string-match carp-bt-re test-s1 test-pos))
168 (assert-equal "foo2.pl"
170 (match-beginning file-group)
171 (match-end file-group)))
174 (match-beginning line-group)
175 (match-end line-group)))
177 (setq test-pos (match-end 0))
178 (assert-equal 119 (string-match carp-bt-re test-s1 test-pos))
179 (assert-equal "foo3.pl"
181 (match-beginning file-group)
182 (match-end file-group)))
185 (match-beginning line-group)
186 (match-end line-group)))