nxhtml/tests/mumamo-test.el

   1 ;;; mumamo-test.el --- Test routines for mumamo
   2 ;;
   3 ;; Author: Lennart Borgman
   4 ;; Created: Sat Mar 31 03:59:26 2007
   5 ;; Version: 0.1
   6 ;; Last-Updated:
   7 ;;
   8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9 ;;
  10 ;;; Commentary:
  11 ;;
  12 ;; This file defines some test for mumamo.el and a the minor mode
  13 ;; `mumamu-test-mode' to bind the test functions to some keys for
  14 ;; convenient use. This will define F3 to run
  15 ;; `mumamo-test-create-chunk-at' and Shift-F3 to
  16 ;; `mumamo-test-create-chunks-at-all-points'.
  17 ;;
  18 ;;
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20 ;;
  21 ;;; Change log:
  22 ;;
  23 ;;
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;
  26 ;;; Code:
  27
  28 ;;(eval-when-compile (require 'mumamo))
  29 (eval-when-compile (require 'mumamo))
  30 (require 'whelp)
  31
  32 ;;;;;;; TESTS, run in fundamental-mode buffer
  33
  34 (defvar mumamo-test-mode-keymap
  35   (let ((map (make-sparse-keymap)))
  36     (define-key map [f11] 'goto-char)
  37     (define-key map [(meta f3)] 'mumamo-test-fontify-region)
  38     (define-key map [(shift f3)] 'mumamo-test-create-chunks-at-all-points)
  39     (define-key map [f3] 'mumamo-test-create-chunk-at-point)
  40     map))
  41
  42 (defvar mumamo-test-current-chunk-family nil)
  43 (make-variable-buffer-local 'mumamo-test-current-chunk-family)
  44
  45 (define-minor-mode mumamo-test-mode
  46   "For testing creating mumamo-mode chunks.
  47 When this mode is on the following keys are defined:
  48
  49   \\{mumamo-test-mode-keymap}
  50
  51 "
  52   nil
  53   " MuMaMo-TEST"
  54   :keymap mumamo-test-mode-keymap
  55   (if mumamo-test-mode
  56       (progn
  57         (setq mumamo-test-current-chunk-family mumamo-current-chunk-family)
  58         (setq mumamo-use-condition-case nil)
  59         (setq mumamo-debugger nil)
  60         (run-with-idle-timer 0 nil 'mumamo-test-tell-bindings))
  61     (setq mumamo-use-condition-case t)
  62     (setq mumamo-debugger (default-value 'mumamo-debugger)))
  63   )
  64
  65 (defun mumamo-test-tell-bindings ()
  66   (save-match-data ;; runs in timer
  67     (let ((s "mumamo-test-mode is on, use F3/shift-F3 for simple testing"))
  68       (put-text-property 0 (length s)
  69                          'face 'font-lock-warning-face
  70                          s)
  71       (message "%s" s))))
  72
  73 ;;(mumamo-test-mode 1)
  74
  75
  76 ;; (defun mumamo-test-fontify-buffer ()
  77 ;;   (interactive)
  78 ;;   (unless mumamo-current-chunk-family
  79 ;;     (mumamo-select-chunk-family))
  80 ;;   ;;(when mumamo-mode (mumamo-mode 0))
  81 ;;   (when mumamo-multi-major-mode (mumamo-turn-off-actions))
  82 ;;   (save-excursion
  83 ;;     (mumamo-remove-all-chunk-overlays)
  84 ;;     (mumamo-save-buffer-state nil
  85 ;;       (put-text-property (point-min) (point-max) 'face nil))
  86 ;;     (mumamo-fontify-buffer)))
  87
  88 (defun mumamo-test-create-chunk-at-point ()
  89   (interactive)
  90   (remove-hook 'post-command-hook 'mumamo-post-command t)
  91   (font-lock-mode -1)
  92   (setq fontification-functions nil)
  93   (save-excursion
  94     (mumamo-remove-all-chunk-overlays)
  95     (mumamo-save-buffer-state nil
  96       (remove-text-properties (point-min) (point-max) '(face nil syntax-table nil)))
  97     (let* ((mumamo-current-chunk-family mumamo-test-current-chunk-family)
  98            (here (point))
  99            chunk
 100            chunk2)
 101       (mumamo-save-buffer-state nil
 102         ;;(setq chunk (mumamo-create-chunk-at here)))
 103         (setq chunk (mumamo-find-chunks here "test1")))
 104       ;;(setq chunk2 (mumamo-get-chunk-at here))
 105       (setq chunk2 (mumamo-find-chunks here "set chunk2"))
 106       ;;(message "mumamo-test-create-chunk-at-point.chunk 1=%s" chunk)
 107       ;;(lwarn 'test-create-chunk-at :warning "chunk=%s, chunk2=%s" chunk chunk2)
 108       ;;(when (overlay-buffer chunk)
 109         (assert (eq chunk chunk2))
 110         ;;)
 111       ;;(message "mumamo-test-create-chunk-at-point.chunk 2=%s" chunk)
 112       ;;(syntax-ppss-flush-cache (1- (overlay-start chunk)))
 113       (syntax-ppss-flush-cache (overlay-start chunk))
 114       (let ((start (overlay-start chunk))
 115             (end   (overlay-end chunk)))
 116         ;;(setq syntax-ppss-last (cons 319 (parse-partial-sexp 1 1)))
 117         ;;(message "mumamo-test-create-chunk-at-point.chunk 2a=%s" chunk)
 118         (mumamo-save-buffer-state nil
 119           (mumamo-fontify-region-1 start end nil)))
 120       ;;(message "mumamo-test-create-chunk-at-point.chunk 3=%s" chunk)
 121       (unless mumamo-test-mode (mumamo-test-mode 1))
 122       ;;(message "mumamo-test-create-chunk-at-point.chunk 4=%s" chunk)
 123       chunk
 124       ;;(message "test 2.debugger=%s" debugger)
 125       ;;(mumamo-get-chunk-at here)
 126       (mumamo-find-chunks here "return value")
 127       )))
 128
 129 (defun mumamo-test-create-chunks-at-all-points ()
 130   (interactive)
 131   ;;(goto-char (point-min))
 132   (let (last-ovl
 133         this-ovl)
 134     (while (< (point) (point-max))
 135       ;;(setq this-ovl (mumamo-test-create-chunk-at-point))
 136       (setq this-ovl (mumamo-find-chunks (point) "test loop"))
 137       ;;(message "this-ovl=%s" this-ovl)
 138       (sit-for 0.005)
 139       ;;(sit-for 0)
 140       (when last-ovl
 141         (if (= (point) (overlay-end last-ovl))
 142             (assert (= (overlay-end last-ovl) (overlay-start this-ovl)))
 143           (assert (= (overlay-start last-ovl) (overlay-start this-ovl)))
 144           (assert (= (overlay-end last-ovl) (overlay-end this-ovl)))
 145           ))
 146       (if last-ovl
 147           (move-overlay last-ovl (overlay-start this-ovl) (overlay-end this-ovl))
 148         (setq last-ovl (make-overlay (overlay-start this-ovl) (overlay-end this-ovl))))
 149       (forward-char 1)
 150       )
 151     (message "No problems found")))
 152
 153 (defun mumamo-test-fontify-region ()
 154   (interactive)
 155   (let ((font-lock-mode t))
 156     ;;(mumamo-fontify-region-with (point-min) (point-max) nil 'php-mode nil)
 157     (mumamo-fontify-region (point-min) (point-max) t)))
 158
 159 ;; Fix-me: can't byte compile:
 160 ;; (defun mumamo-test-easy-make ()
 161 ;;   (interactive)
 162 ;;   (let ((start-str "--Start Submode:")
 163 ;;         (end-str "--End Submode--")
 164 ;;         (start-reg nil))
 165 ;;     (setq start-reg
 166 ;;           ;; (rx
 167 ;;           ;;  (eval start-str)
 168 ;;           ;;  (0+ space)
 169 ;;           ;;  (submatch
 170 ;;           ;;   (0+ (any "a-z-")))
 171 ;;           ;;  (0+ space)
 172 ;;           ;;  "--"
 173 ;;           ;;  )
 174 ;;           (rx-to-string
 175 ;;            `(and
 176 ;;              ,start-str
 177 ;;              (0+ space)
 178 ;;              (submatch
 179 ;;               (0+ (any "a-z-")))
 180 ;;              (0+ space)
 181 ;;              "--"
 182 ;;              ))
 183 ;;           )
 184 ;;     (mumamo-easy-make-chunk-fun testchunk
 185 ;;       start-str
 186 ;;       start-reg
 187 ;;       end-str))
 188 ;;   (setq mumamo-current-chunk-family
 189 ;;         (list "testing"
 190 ;;               'text-mode
 191 ;;               (list
 192 ;;                'testchunk
 193 ;;                ))))
 194
 195 ;; (defun mumamo-test-emb-perl ()
 196 ;;   (interactive)
 197 ;;   (let ((start-str "[-")
 198 ;;         (end-str "-]")
 199 ;;         (start-reg nil))
 200 ;;     (mumamo-easy-make-chunk-fun testchunk-ep
 201 ;;       start-str
 202 ;;       start-reg
 203 ;;       end-str))
 204 ;;   (setq mumamo-current-chunk-family
 205 ;;         (list "emb perl test"
 206 ;;               'perl-mode
 207 ;;               (list
 208 ;;                'testchunk-ep
 209 ;;                ))))
 210
 211
 212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 213 ;; These are for testing bad initialization in mumamo. They can be
 214 ;; used for example with php-mode. (They are mainly for development
 215 ;; purposes.)
 216 ;;
 217 ;; (mumamo-bad-c-init)
 218 (defun mumamo-bad-c-init() (/ 1 0))
 219 (defun mumamo-setup-bad-c-init ()
 220   (interactive)
 221   (add-hook 'c-mode-common-hook 'mumamo-bad-c-init))
 222 (defun mumamo-teardown-bad-c-init ()
 223   (interactive)
 224   (remove-hook 'c-mode-common-hook 'mumamo-bad-c-init))
 225
 226
 227 ;; (defmacro mumamo-get-backtrace (bodyform)
 228 ;;   "Evaluate BODYFORM, return backtrace as a string.
 229 ;; If there is an error in BODYFORM then return the backtrace as a
 230 ;; string, otherwise return nil."
 231 ;;   `(let* ((debugger-ret nil)
 232 ;;           (debugger (lambda (&rest debugger-args)
 233 ;;                       (message "DEBUGGER CALLED BEFORE")
 234 ;;                       (setq debugger-ret (with-output-to-string (backtrace)))
 235 ;;                       (message "DEBUGGER CALLED AFTER, debugger-ret=%s" debugger-ret)
 236 ;;                       ))
 237 ;;           (debug-on-error t)
 238 ;;           (debug-on-signal t)
 239 ;;           )
 240 ;;      (condition-case err
 241 ;;          (progn
 242 ;;            ,bodyform
 243 ;;            nil)
 244 ;;        (error
 245 ;;         (message "err=%S" err)
 246 ;;         (message "debugger-ret=%S\n\n\n" debugger-ret)
 247 ;;         (let* ((errmsg (error-message-string err))
 248 ;;                (debugger-lines (split-string debugger-ret "\n"))
 249 ;;                (dbg-ret (mapconcat 'identity (nthcdr 6 debugger-lines) "\n")))
 250 ;;           (concat errmsg "\n" dbg-ret))))))
 251
 252 ;; (defun mumamo-test3-debug()
 253 ;;   (interactive)
 254 ;;   (message "%s"
 255 ;;            (mumamo-get-backtrace
 256 ;;             (mumamo-test-major-mode-init 'php-mode))))
 257
 258 ;; (defun mumamo-test2-debug()
 259 ;;   (interactive)
 260 ;;   (mumamo-condition-case var
 261 ;;                          (mumamo-test-major-mode-init 'php-mode)
 262 ;;                          handlers))
 263
 264 (defun mumamo-test-debug()
 265   (interactive)
 266   (condition-case err
 267       (let ((debugger 'mumamo-debug)
 268             (debug-on-error t)
 269             (debug-on-signal t))
 270         ;;(message "here d")(sit-for 1)
 271         (mumamo-test-major-mode-init 'php-mode))
 272     (error (message "here 2 err=%S" err))))
 273
 274 (defun mumamo-debug (&rest debugger-args)
 275   (let ((s (with-output-to-string (backtrace))))
 276     (message "mumamo-debug: %s" s)))
 277
 278 ;; (defun mumamo-bt-to-msg (msg)
 279 ;;   (mumamo-msgfntfy "%s: %s" msg
 280 ;;            (with-output-to-string
 281 ;;              (backtrace))))
 282
 283 (defun mumamo-test-major-mode-init (major)
 284   "Turn on major mode MAJOR in a temp buffer.
 285 This function should be used after getting errors during
 286 fontification where the message in the *Message* buffer tells
 287 that you should call it to get a traceback.
 288
 289 Send the traceback you get, if any, together with the message in
 290 the message buffer when reporting the error."
 291   (interactive "CMajor mode: ")
 292   (with-temp-buffer
 293     ;;(setq mumamo-explicitly-turned-on-off t)
 294     (setq debug-on-error t)
 295     (funcall major)))
 296
 297 (provide 'mumamo-test)
 298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 299 ;;; mumamo-test.el ends here