1 ;;; mumamo-test.el --- Test routines for mumamo
3 ;; Author: Lennart Borgman
4 ;; Created: Sat Mar 31 03:59:26 2007
8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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'.
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;(eval-when-compile (require 'mumamo))
29 (eval-when-compile (require 'mumamo))
32 ;;;;;;; TESTS, run in fundamental-mode buffer
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)
42 (defvar mumamo-test-current-chunk-family nil)
43 (make-variable-buffer-local 'mumamo-test-current-chunk-family)
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:
49 \\{mumamo-test-mode-keymap}
54 :keymap mumamo-test-mode-keymap
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)))
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
73 ;;(mumamo-test-mode 1)
76 ;; (defun mumamo-test-fontify-buffer ()
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))
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)))
88 (defun mumamo-test-create-chunk-at-point ()
90 (remove-hook 'post-command-hook 'mumamo-post-command t)
92 (setq fontification-functions nil)
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)
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))
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)
124 ;;(message "test 2.debugger=%s" debugger)
125 ;;(mumamo-get-chunk-at here)
126 (mumamo-find-chunks here "return value")
129 (defun mumamo-test-create-chunks-at-all-points ()
131 ;;(goto-char (point-min))
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)
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)))
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))))
151 (message "No problems found")))
153 (defun mumamo-test-fontify-region ()
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)))
159 ;; Fix-me: can't byte compile:
160 ;; (defun mumamo-test-easy-make ()
162 ;; (let ((start-str "--Start Submode:")
163 ;; (end-str "--End Submode--")
167 ;; ;; (eval start-str)
170 ;; ;; (0+ (any "a-z-")))
179 ;; (0+ (any "a-z-")))
184 ;; (mumamo-easy-make-chunk-fun testchunk
188 ;; (setq mumamo-current-chunk-family
195 ;; (defun mumamo-test-emb-perl ()
197 ;; (let ((start-str "[-")
200 ;; (mumamo-easy-make-chunk-fun testchunk-ep
204 ;; (setq mumamo-current-chunk-family
205 ;; (list "emb perl test"
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
217 ;; (mumamo-bad-c-init)
218 (defun mumamo-bad-c-init() (/ 1 0))
219 (defun mumamo-setup-bad-c-init ()
221 (add-hook 'c-mode-common-hook 'mumamo-bad-c-init))
222 (defun mumamo-teardown-bad-c-init ()
224 (remove-hook 'c-mode-common-hook 'mumamo-bad-c-init))
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)
237 ;; (debug-on-error t)
238 ;; (debug-on-signal t)
240 ;; (condition-case err
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))))))
252 ;; (defun mumamo-test3-debug()
255 ;; (mumamo-get-backtrace
256 ;; (mumamo-test-major-mode-init 'php-mode))))
258 ;; (defun mumamo-test2-debug()
260 ;; (mumamo-condition-case var
261 ;; (mumamo-test-major-mode-init 'php-mode)
264 (defun mumamo-test-debug()
267 (let ((debugger 'mumamo-debug)
270 ;;(message "here d")(sit-for 1)
271 (mumamo-test-major-mode-init 'php-mode))
272 (error (message "here 2 err=%S" err))))
274 (defun mumamo-debug (&rest debugger-args)
275 (let ((s (with-output-to-string (backtrace))))
276 (message "mumamo-debug: %s" s)))
278 ;; (defun mumamo-bt-to-msg (msg)
279 ;; (mumamo-msgfntfy "%s: %s" msg
280 ;; (with-output-to-string
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.
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: ")
293 ;;(setq mumamo-explicitly-turned-on-off t)
294 (setq debug-on-error t)
297 (provide 'mumamo-test)
298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
299 ;;; mumamo-test.el ends here