code.delx.au - gnu-emacs-elpa/blob - packages/realgud/test/test-loc-regexp-trepanpl.el

   1 (load-file "./regexp-helper.el")
   2 (load-file "../realgud/common/regexp.el")
   3 (load-file "../realgud/debugger/trepan.pl/init.el")
   4
   5 (declare-function realgud-cmdbuf-info-loc-regexp 'realgud-buffer-command)
   6 (declare-function cmdbuf-loc-match               'realgud-regexp-helper)
   7 (declare-function realgud-loc-pat-regexp         'realgud-regexp)
   8 (declare-function realgud-loc-pat-file-group     'realgud-regexp)
   9 (declare-function realgud-loc-pat-line-group     'realgud-regexp)
  10 (declare-function realgud-cmdbuf-info-file-group 'realgud-regexp)
  11 (declare-function realgud-cmdbuf-info-line-group 'realgud-regexp)
  12 (declare-function realgud-cmdbuf-info            'realgud-regexp)
  13 (declare-function make-realgud-cmdbuf-info       'realgud-regexp)
  14 (declare-function realgud-loc-pat-num            'realgud-regexp)
  15 (declare-function test-simple-start 'test-simple)
  16 (declare-function assert-t 'test-simple)
  17 (declare-function assert-equal 'test-simple)
  18 (declare-function note 'test-simple)
  19 (declare-function end-tests 'test-simple)
  20
  21 (test-simple-start)
  22
  23 (eval-when-compile
  24   (defvar file-group)
  25   (defvar frame-re)
  26   (defvar line-group)
  27   (defvar num-group)
  28   (defvar test-pos)
  29   (defvar dbg-name)
  30   (defvar realgud-pat-hash)
  31   (defvar loc-pat)
  32   (defvar test-dbgr)
  33   (defvar test-s1)
  34   (defvar realgud-pat-bt)
  35   (defvar realgud:trepanpl-pat-hash)
  36 )
  37
  38 ; Some setup usually done in setting up the buffer.
  39 ; We customize this for the debugger trepan. Others may follow.
  40 ; FIXME: encapsulate this.
  41 (setq dbg-name "trepan.pl")
  42 (setq loc-pat (gethash "loc" (gethash dbg-name realgud-pat-hash)))
  43
  44 (setq test-dbgr (make-realgud-cmdbuf-info
  45                  :debugger-name dbg-name
  46                  :loc-regexp (realgud-loc-pat-regexp loc-pat)
  47                  :file-group (realgud-loc-pat-file-group loc-pat)
  48                  :line-group (realgud-loc-pat-line-group loc-pat)))
  49
  50
  51 (setq test-s1 "-- main::(../example/gcd.pl:18)")
  52 (assert-t (numberp (cmdbuf-loc-match test-s1 test-dbgr)) "basic location")
  53
  54 (assert-equal 0 (cmdbuf-loc-match test-s1 test-dbgr))
  55
  56 (note "extract location fields")
  57 (assert-equal "../example/gcd.pl"
  58               (match-string (realgud-cmdbuf-info-file-group test-dbgr)
  59                             test-s1))
  60
  61 (assert-equal "18"
  62               (match-string
  63                (realgud-cmdbuf-info-line-group test-dbgr)
  64                test-s1) "extract line number")
  65
  66
  67 (note "Test with hex location")
  68 (setq test-s1 "-- File::Basename::(/usr/share/perl/5.14/File/Basename.pm:284 @0x8918b70)")
  69 (assert-t (numberp (cmdbuf-loc-match test-s1 test-dbgr)) "basic location")
  70 (assert-equal 0 (cmdbuf-loc-match test-s1 test-dbgr))
  71
  72 (assert-equal "/usr/share/perl/5.14/File/Basename.pm"
  73               (match-string (realgud-cmdbuf-info-file-group test-dbgr)
  74                             test-s1))
  75
  76 (assert-equal "284"
  77               (match-string
  78                (realgud-cmdbuf-info-line-group test-dbgr)
  79                test-s1) "extract line number")
  80
  81
  82 (note "debugger-backtrace")
  83 (setq realgud-pat-bt  (gethash "debugger-backtrace"
  84                              realgud:trepanpl-pat-hash))
  85 (setq test-s1
  86       "--> #0 @ = File::Basename::fileparse('/usr/local/bin/trepan.pl') in
  87         file `/usr/share/perl/5.18.2/File/Basename.pm' at line 107
  88     #1 @ = File::Basename::dirname('/usr/local/bin/trepan.pl') in
  89         file `/usr/share/perl/5.18.2/File/Basename1.pm' at line 294
  90     #2 file `/usr/local/bin/trepan.pl' at line 11
  91 ")
  92 (setq frame-re (realgud-loc-pat-regexp realgud-pat-bt))
  93 (setq num-group (realgud-loc-pat-num realgud-pat-bt))
  94 (setq file-group (realgud-loc-pat-file-group realgud-pat-bt))
  95 (setq line-group (realgud-loc-pat-line-group realgud-pat-bt))
  96 (assert-equal 0 (string-match frame-re test-s1))
  97 (assert-equal "0" (substring test-s1
  98                              (match-beginning num-group)
  99                              (match-end num-group)))
 100 (assert-equal "/usr/share/perl/5.18.2/File/Basename.pm"
 101               (substring test-s1
 102                          (match-beginning file-group)
 103                          (match-end file-group)))
 104 (assert-equal "107"
 105               (substring test-s1
 106                          (match-beginning line-group)
 107                          (match-end line-group)))
 108 (setq test-pos (match-end 0))
 109
 110 (assert-equal 127 (string-match frame-re test-s1 test-pos))
 111 (assert-equal "1" (substring test-s1
 112                              (match-beginning num-group)
 113                              (match-end num-group)))
 114 (assert-equal "/usr/share/perl/5.18.2/File/Basename1.pm"
 115               (substring test-s1
 116                          (match-beginning file-group)
 117                          (match-end file-group)))
 118 (assert-equal "294"
 119               (substring test-s1
 120                          (match-beginning line-group)
 121                          (match-end line-group)))
 122 (setq test-pos (match-end 0))
 123 (assert-equal 254 test-pos)
 124
 125 (end-tests)