needy_debugger 1.4.0

data/emacs/test/elk-test.el

@@ -0,0 +1,242 @@
+;;; elk-test.el --- Emacs Lisp testing suite
+
+;; Copyright (C) 2006 Nikolaj Schumacher <bugs * nschum , de>
+
+;;; License
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+;;; Usage
+
+;; Use `deftest' to define a test and `run-elk-test' to run it.
+;; Create test bundles with `defsuite' or `build-suite'.
+;; Verify your code with  `assert-equal', `assert-eq', `assert-eql',
+;; `assert-nonnil', `assert-t', `assert-nil' and `assert-error'
+;; to verify your code.
+
+;;; Examples
+
+;; (deftest "test1"
+;;   (assert-equal t t)
+;;   (assert-eq t 'foo))
+
+;; (defsuite "suite1"
+;;   (deftest "test1" (assert-equal t t)))
+
+;; (deftest "test2"
+;;   (assert-equal t t))
+;; (build-suite "combined-suite" "test1" "test2")
+
+;; (run-elk-test "combined-suite")
+;; (run-elk-test)
+
+(require 'cl)
+
+(defvar elk-test-run-on-define nil
+  "If non-nil, run elk-test tests/suites immediately when defining them.")
+
+(defvar elk-test-map (make-hash-table :test 'equal)
+  "A map of elk-test test/suite names to their implementation.")
+
+(defvar elk-test-list nil
+  "A list of all defined elk-test tests/suites.")
+
+(defun elk-test-clear ()
+  "Remove all tests from memory."
+  (setq elk-test-map (make-hash-table :test 'equal)
+        elk-test-list nil))
+
+(defun run-elk-test (name &optional string-result)
+  "Run the test case defined as NAME.
+The result is a list of errors strings, unless STRING-RESULT is set, in which
+case a message describing the errors or success is displayed and returned."
+  (interactive
+   (list (completing-read "Test name: " elk-test-list nil t)))
+  (let ((name name))
+  (let ((elk-test-errors nil)
+        (test-or-suite (gethash name elk-test-map)))
+    (if (not test-or-suite)
+        (error "Undefined test <%s>" name)
+      (if (equal (car test-or-suite) 'suite)
+          ;; is test suite
+          (let ((map (cadr test-or-suite)))
+            (dolist (test (caddr test-or-suite))
+              (setq elk-test-errors
+                    (append elk-test-errors
+                            (run-elk-test-internal (gethash test map))))))
+        ;; is simple test
+        (setq elk-test-errors (run-elk-test-internal test-or-suite)))
+      (if (or string-result (interactive-p))
+          (message (if elk-test-errors
+                       (mapconcat 'identity elk-test-errors "\n")
+                     "Test run was successful."))
+        elk-test-errors)))))
+
+(defun run-elk-tests-buffer (&optional buffer)
+  "Execute BUFFER as lisp code and run all tests therein."
+  (interactive)
+  (let* ((elk-test-list)
+         (elk-test-map (make-hash-table :test 'equal))
+         (elk-test-run-on-define nil)
+         (inhibit-read-only t)
+         (buffer-name (buffer-name buffer))
+         (success t)
+         (parse-res (condition-case err (eval-buffer buffer) (error err))))
+    (if parse-res
+        (message "Parsing buffer <%s> failed:\n%s"
+                 buffer-name parse-res)
+      (let ((out-buffer (get-buffer-create
+                         (concat "*elk-test run " buffer-name "*")))
+            failure)
+        (with-current-buffer out-buffer
+          (erase-buffer)
+          (dolist (test elk-test-list)
+            (message "running <%s>" test)
+            (let ((results (run-elk-test test)))
+              (when results
+                (setq failure t)
+                (insert "test <" test "> failed:\n")
+                (dolist (result results)
+                  (insert "* " result "\n"))))))
+        (if failure
+            (display-buffer out-buffer)
+          (kill-buffer out-buffer)
+          (message "Test run was successful."))))))
+
+(defun run-elk-test-internal (test)
+  (let ((elk-test-errors nil))
+    (dolist (sexpr test)
+      (let ((problem (condition-case err (progn (eval sexpr) nil) (error err))))
+        (when problem
+          (push (message "%s" problem) elk-test-errors))))
+    elk-test-errors))
+
+(defmacro elk-test-error (format-string &rest args)
+  "Create an error string as the result of a failed elk-test assertion.
+The first argument is a format control string, and the rest are data to be
+formatted under control of the string.  See `format' for details.
+
+The result will be displayed, returned and if called inside of `run-elk-test'
+added to the internal error list."
+  `(let ((string (message ,format-string ,@args)))
+     (when (boundp 'elk-test-errors)
+       (push string elk-test-errors))
+     string))
+
+(defmacro assert-equal (expected actual)
+  "Assert that ACTUAL equals EXPECTED, or signal a warning."
+  `(unless (equal ,expected ,actual)
+    (elk-test-error "assert-equal for <%s> failed: expected <%s>, was <%s>"
+                    ',actual ,expected ,actual)))
+
+(defmacro assert-eq (expected actual)
+  "Assert that ACTUAL equals EXPECTED, or signal a warning."
+  `(unless (eq ,expected ,actual)
+    (elk-test-error "assert-eq for <%s> failed: expected <%s>, was <%s>"
+                    ',actual ,expected ,actual)))
+
+(defmacro assert-eql (expected actual)
+  "Assert that ACTUAL equals EXPECTED, or signal a warning."
+  `(unless (eql ,expected ,actual)
+    (elk-test-error "assert-eql for <%s> failed: expected <%s>, was <%s>"
+                    ',actual ,expected ,actual)))
+
+(defmacro assert-nonnil (value)
+  "Assert that VALUE is not nil, or signal a warning."
+  `(unless ,value
+     (elk-test-error "assert-nonnil for <%s> failed: was <%s>"
+                     ',value ,value)))
+
+(defmacro assert-t (value)
+  "Assert that VALUE is t, or signal a warning."
+  `(unless (eq ,value t)
+     (elk-test-error "assert-t for <%s> failed: was <%s>"
+                     ',value ,value)))
+
+(defmacro assert-nil (value)
+  "Assert that VALUE is nil, or signal a warning."
+  `(when ,value
+     (elk-test-error "assert-nil for <%s> failed: was <%s>"
+                     ',value ,value)))
+
+(defmacro assert-error (error-message &rest body)
+  "Assert that BODY raises an `error', or signal a warning.
+ERROR-MESSAGE is the expected error string, use nil to accept any error.  Use
+nil with caution, as errors like 'wrong-number-of-arguments' (likely caused by
+typos) will also be caught!"
+  `(let ((elk-test-error
+          (condition-case elk-test-error
+              (progn ,@body)
+            (error (cons 'elk-test-error (cadr elk-test-error))))))
+     (if (not (eq (car elk-test-error) 'elk-test-error))
+         ;; no error
+         (elk-test-error "assert-error for <%s> failed: did not raise an error"
+                         (append '(progn) ',body))
+       (when (and ,error-message
+                  (not (equal ,error-message (cdr elk-test-error))))
+         (elk-test-error (concat "assert-error for <%s> failed: expected <%s>, "
+                                 "raised <%s>")
+                         (append '(progn) ',body)
+                         ,error-message (cdr elk-test-error))))))
+
+(defmacro deftest (name &rest body)
+  "Define a test case.
+Use `assert-equal', `assert-eq', `assert-eql', `assert-nonnil', `assert-t',
+`assert-nil' and `assert-error' to verify the code."
+  `(progn (unless (gethash ,name elk-test-map)
+            (push ,name elk-test-list))
+          (puthash ,name ',body elk-test-map)
+          ,(if elk-test-run-on-define
+               `(run-elk-test ',name ,t)
+             name)))
+
+(defmacro defsuite (name &rest body)
+  "Define a test suite using a collection of `deftest' forms.
+The resulting suite can be called with `run-elk-test' and parameter NAME."
+  `(let ((suite
+          (let ((elk-test-map (make-hash-table :test 'equal))
+                (elk-test-list nil))
+            ,@body
+            (list 'suite elk-test-map (reverse elk-test-list)))))
+     (unless (gethash ,name elk-test-map)
+       (push ,name elk-test-list))
+     (puthash ,name suite elk-test-map)
+     ,(if elk-test-run-on-define
+          `(run-elk-test ,name t)
+        name)))
+
+(defun build-suite (name &rest tests)
+  "Define a test suite using a collection of test names.
+The resulting suite can be run by calling `run-elk-test' with parameter NAME."
+  (unless (gethash name elk-test-map)
+    (push name elk-test-list))
+  (puthash name
+           (let ((map (make-hash-table :test 'equal))
+                 (list nil))
+             (dolist (test-name tests)
+               (push test-name list)
+               (when (gethash test-name map)
+                 (error "Test used twice"))
+               (let ((test (gethash test-name elk-test-map)))
+                 (unless test
+                   (error "Undefined test <%s>" test-name))
+                 (puthash test-name test map)))
+             (list 'suite map (reverse list)))
+           elk-test-map)
+  (if elk-test-run-on-define
+      (run-elk-test "sample suite" t)
+    name))
+
+(provide 'elk-test)

data/emacs/test/test-annotate.el

@@ -0,0 +1,103 @@
+;; -*- emacs-lisp -*-
+;; This program has to be run from the directory it is currently in and
+;; the rdebug code has to be in the parent directory
+(load-file "./elk-test.el")
+
+;; FIXME? Should we use "require 'rdebug" here.
+;; Would have to prepend . to load-path. 
+(load-file "../rdebug.el")
+(load-file "../rdebug-annotate.el")
+
+(defvar last-annotation nil
+  "Value of the last annotation processed")
+
+;; Redefine functions to make them harmless for testing
+(defun rdebug-process-annotation (name contents)
+  (setq last-annotation name))
+
+(make-variable-buffer-local 'gud-rdebug-marker-acc)
+
+;; -------------------------------------------------------------------
+;; Test harness for testing the filter.
+;;
+
+(require 'advice)
+
+(defvar rdebug-test-cmd-list '())
+
+;; Override, partially because tooltip-show doesn't work in batch
+;; mode, and partially because we collect the output here.
+(defun tooltip-show (text)
+  (setq rdebug-test-cmd-list (cons text rdebug-test-cmd-list)))
+
+(defun assert-filter (output str &optional cmd-list)
+  (setq rdebug-test-cmd-list '())
+  (setq gud-marker-acc "")
+  (let ((orig-queue rdebug-call-queue))
+    (let ((real-output (gud-rdebug-marker-filter str)))
+      (assert-equal output real-output)
+      (assert-equal cmd-list (reverse rdebug-test-cmd-list)))
+
+    ;;
+    ;; Feed the filter one character at a time -- the end result should
+    ;; be the same.
+    ;;
+    (setq rdebug-test-cmd-list '())
+    (setq gud-marker-acc "")
+    (let ((real-output "")
+          (len (length str))
+          (i 0)
+          (rdebug-call-queue orig-queue))
+      (while (< i len)
+        (setq real-output
+              (concat real-output
+                      (gud-rdebug-marker-filter
+                       (substring str i (if (equal (+ 1 i) len)
+                                            nil
+                                          (+ 1 i))))))
+        (setq i (+ 1 i)))
+      (assert-equal output real-output)
+      (assert-equal cmd-list (reverse rdebug-test-cmd-list)))))
+
+
+(deftest "rdebug-filter"
+;;;   (assert-filter "X" "X")
+;;;   (assert-filter "XYZ" "XYZ")
+;;;   (assert-filter "" "\n")
+;;;   (assert-filter "Testing 1 2 3" "Testing 1 2 3")
+;;;   (assert-filter "Testing 1 2 3" "Testing 1 2 3")
+;;;   (assert-filter "ABC" "\
+;;; breakpoints
+;;; No breakpoints
+;;; 
+;;; ABC")
+
+  ;; Some systems (read: Mac) echoes the command.
+  (setq rdebug-call-queue '(("pp 100" :tooltip)))
+  (assert-filter "pp 100\n100\n(rdb:1) " "\
+prompt
+pp 100\n100
+pre-prompt
+\(rdb:1) \nprompt\n"
+                 '("100\n"))
+
+  ;; Some systems don't echo the command.
+  (setq rdebug-call-queue '(("pp 100" :tooltip)))
+  (assert-filter "100\n(rdb:1) " "\
+prompt
+100
+pre-prompt
+\(rdb:1) \nprompt\n"
+                 '("100\n"))
+  )
+
+
+;; -------------------------------------------------------------------
+;; Build and run the test suite.
+;;
+
+(build-suite "rdebug-suite" 
+             "rdebug-filter")
+
+(run-elk-test "rdebug-suite"
+              "test regular expressions used in tracking lines")

data/emacs/test/test-cmd.el

@@ -0,0 +1,116 @@
+;; -*- emacs-lisp -*-
+;; This program has to be run from the directory it is currently in and
+;; the rdebug code has to be in the parent directory
+(load-file "./elk-test.el")
+
+(setq load-path (cons ".." load-path))
+(require 'rdebug-core)
+(require 'rdebug-gud)
+(setq load-path (cdr load-path))
+
+(defvar last-gud-call nil
+  "Value of the last gud-call")
+
+;; Redefine functions to make them harmless for testing
+(defun gud-call (command)
+  (setq last-gud-call command))
+
+(defun rdebug-call (command)
+  (setq last-gud-call command))
+
+(deftest "rdebug-goto-frame-test"
+  (let ((buf (generate-new-buffer "testing")))
+    (save-excursion
+      (switch-to-buffer buf)
+      (insert "#0 ERB.result(b#Binding) at line /usr/lib/ruby/1.8/erb.rb:736\n")
+      (insert "#1 Listings.build at line erbtest.rb:24\n")
+      (insert "#2 at line erbtest.rb:33\n")
+      (insert "#10 Listings.build at line erbtest.rb:23")
+      (goto-char (point-min))
+      (setq last-gud-call nil)
+      (setq rdebug-goto-entry-acc "")
+
+      ;; --------------------
+      ;; The tests
+
+      (rdebug-goto-frame-n-internal "5")
+      (assert-equal nil last-gud-call)
+      (rdebug-goto-frame-n-internal "1")
+      (assert-equal "frame 1" last-gud-call)
+      (rdebug-goto-frame-n-internal "0")
+      (assert-equal "frame 10" last-gud-call))
+    (kill-buffer buf)))
+
+
+;; -------------------------------------------------------------------
+;; Check breakpoint toggle commands
+;;
+
+(deftest "rdebug-toggle-breakpoints"
+  (let ((buf (generate-new-buffer "*rdebug-breakpoint-test.rb*"))
+        ;; Needed by `rdebug-breakpoint-parse-and-update-cache'.
+        (gud-comint-buffer (current-buffer)))
+    (save-excursion
+      (switch-to-buffer buf)
+      (insert "Num Enb What\n")
+      (insert "  1 y   at /test.rb:10\n")
+      (insert "  2 n   at /test.rb:11\n")
+      (insert "  3 y   at /test.rb:12\n")
+      (insert "  4 y   at /test.rb:13\n")
+      (rdebug-breakpoint-parse-and-update-cache))
+    (setq gud-target-name "test.rb")
+
+    ;; ----------
+    ;; Toggle break point
+    (assert-equal 4 (length (rdebug-all-breakpoints)))
+
+    ;; ----------
+    ;; Toggle break point
+
+    ;; Add new.
+    (rdebug-toggle-source-breakpoint "/test.rb" 20)
+    (assert-equal "break /test.rb:20" last-gud-call)
+    ;; Delete enabled.
+    (rdebug-toggle-source-breakpoint "/test.rb" 10)
+    (assert-equal "delete 1" last-gud-call)
+    ;; Delete disabled.
+    (rdebug-toggle-source-breakpoint "/test.rb" 11)
+    (assert-equal "delete 2" last-gud-call)
+
+    ;; ----------
+    ;; Toggle enable/disable.
+
+    ;; Add new.
+    (rdebug-toggle-source-breakpoint-enabled "/test.rb" 30)
+    (assert-equal "break /test.rb:30" last-gud-call)
+
+    ;; Toggle enabled.
+    (rdebug-toggle-source-breakpoint-enabled "/test.rb" 10)
+    (assert-equal "disable 1" last-gud-call)
+    ;; Toggle disabled.
+    (rdebug-toggle-source-breakpoint-enabled "/test.rb" 11)
+    (assert-equal "enable 2" last-gud-call)))
+
+
+;; -------------------------------------------------------------------
+;; Check rdebug-next with prefix toggling commands
+;;
+(deftest "rdebug-stepping-test"
+  (setq rdebug-stepping-prefix "")
+  (assert-equal "next 1" (rdebug-next))
+  (setq rdebug-stepping-prefix "-")
+  (assert-equal "next- 2" (rdebug-next 2))
+  (setq rdebug-stepping-prefix "+")
+  (assert-equal "step+ 1" (rdebug-step))
+  )
+
+;; -------------------------------------------------------------------
+;; Build and run the test suite.
+;;
+
+(build-suite "rdebug-cmd-suite"
+	     "rdebug-goto-frame-test"
+	     "rdebug-stepping-test"
+	     "rdebug-toggle-breakpoints")
+(run-elk-test "rdebug-cmd-suite"
+              "test some rdebug-core code")