Fix Emacs 24 compatibility issue with Emacs 24
[org-mode.git] / testing / lisp / test-ob.el
blob58ff756be3ddc2932c8b1e1d9ea59d5d3db5a3a7
1 ;;; test-ob.el --- tests for ob.el
3 ;; Copyright (c) 2010, 2011 Eric Schulte
4 ;; Authors: Eric Schulte, Martyn Jago
6 ;; Released under the GNU General Public License version 3
7 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
9 (let ((load-path (cons (expand-file-name
10 ".." (file-name-directory
11 (or load-file-name buffer-file-name)))
12 load-path)))
13 (require 'org-test)
14 (require 'org-test-ob-consts))
16 (ert-deftest test-org-babel/src-name-regexp ()
17 (should(equal "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
18 org-babel-src-name-regexp))
19 (mapcar (lambda (name)
20 (should (org-test-string-exact-match
21 org-babel-src-name-regexp
22 (concat
23 " \t #+"
24 name
25 ": \t src-name \t blah blah blah ")))
26 (should (string-match
27 org-babel-src-name-regexp
28 (concat
29 "#+" (upcase name)
30 ": src-name")))
31 ;;TODO This should fail no?
32 (should (org-test-string-exact-match
33 org-babel-src-name-regexp
34 (concat
35 "#+" name ":")))
36 ;;TODO Check - should this pass?
37 (should (not (org-test-string-exact-match
38 org-babel-src-name-regexp
39 (concat
40 "#+" name " : src-name")))))
41 '("srcname" "source" "function"))
42 (should (not (org-test-string-exact-match
43 org-babel-src-name-regexp
44 "#+invalid-name: src-name"))))
46 (ert-deftest test-org-babel/multi-line-header-regexp ()
47 (should(equal "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
48 org-babel-multi-line-header-regexp))
49 ;;TODO can be optimised - and what about blah4 blah5 blah6?
50 (should (string-match
51 org-babel-multi-line-header-regexp
52 " \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))
53 (should
54 (equal
55 "blah1 blah2 blah3 \t"
56 (match-string
58 " \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n")))
60 ;;TODO Check - should this fail?
61 (should
62 (not (org-test-string-exact-match
63 org-babel-multi-line-header-regexp
64 " \t #+headers : blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
66 (ert-deftest test-org-babel/src-name-w-name-regexp ()
67 (should(equal
68 (concat org-babel-src-name-regexp "\\("
69 org-babel-multi-line-header-regexp "\\)*"
70 "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
71 org-babel-src-name-w-name-regexp))
72 (should (org-test-string-exact-match
73 org-babel-src-name-w-name-regexp
74 (concat
75 "#+srcname: src-name "
76 "#+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
78 (ert-deftest test-org-babel/src-block-regexp ()
79 (let ((test-block
80 (concat
81 "#+begin_src language -n-r-a-b -c :argument-1 yes :argument-2 no\n"
82 "echo this is a test\n"
83 "echo Currently in ' $PWD\n"
84 "#+end_src"))
85 (language "language")
86 (flags "-n-r-a-b -c ")
87 (arguments ":argument-1 yes :argument-2 no")
88 (body "echo this is a test\necho Currently in ' $PWD\n"))
89 (should (string-match org-babel-src-block-regexp test-block))
90 (should (string-match org-babel-src-block-regexp (upcase test-block)))
91 (should (equal language (match-string 2 test-block)))
92 ;;TODO Consider refactoring
93 (should (equal flags (match-string 3 test-block)))
94 (should (equal arguments (match-string 4 test-block)))
95 (should (equal body (match-string 5 test-block)))
96 ;;no switches
97 (should (org-test-string-exact-match
98 org-babel-src-block-regexp
99 (replace-regexp-in-string flags "" test-block)))
100 ;;no header arguments
101 (should (org-test-string-exact-match
102 org-babel-src-block-regexp
103 (replace-regexp-in-string arguments "" test-block)))
104 ;; should be valid with no body
105 (should (org-test-string-exact-match
106 org-babel-src-block-regexp
107 (replace-regexp-in-string body "" test-block)))))
109 (ert-deftest test-org-babel/get-header ()
110 (should (not (org-babel-get-header
111 org-babel-default-header-args :doesnt-exist)))
112 (should(equal '((:session . "none"))
113 (org-babel-get-header
114 org-babel-default-header-args :session)))
115 (should(equal '((:session . "none"))
116 (org-babel-get-header
117 org-babel-default-header-args :session nil)))
118 (should (not (org-babel-get-header
119 org-babel-default-header-args :SESSION)))
120 (should (equal '((:tangle . "no"))
121 (org-babel-get-header
122 org-babel-default-header-args :tangle)))
123 ;; with OTHERS option
124 (should (equal org-babel-default-header-args
125 (org-babel-get-header
126 org-babel-default-header-args :doesnt-exist 'others)))
127 (should (equal org-babel-default-header-args
128 (org-babel-get-header
129 org-babel-default-header-args nil 'others)))
130 (should (null
131 (assoc :noweb
132 (org-babel-get-header
133 org-babel-default-header-args :noweb 'others)))))
135 (ert-deftest test-org-babel/default-inline-header-args ()
136 (should(equal
137 '((:session . "none") (:results . "replace") (:exports . "results"))
138 org-babel-default-inline-header-args)))
140 ;;; ob-get-src-block-info
141 (ert-deftest test-org-babel/get-src-block-info-language ()
142 (org-test-at-marker nil org-test-file-ob-anchor
143 (let ((info (org-babel-get-src-block-info)))
144 (should (string= "emacs-lisp" (nth 0 info))))))
146 (ert-deftest test-org-babel/get-src-block-info-body ()
147 (org-test-at-marker nil org-test-file-ob-anchor
148 (let ((info (org-babel-get-src-block-info)))
149 (should (string-match (regexp-quote org-test-file-ob-anchor)
150 (nth 1 info))))))
152 (ert-deftest test-org-babel/get-src-block-info-tangle ()
153 (org-test-at-marker nil org-test-file-ob-anchor
154 (let ((info (org-babel-get-src-block-info)))
155 (should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
157 (ert-deftest test-org-babel/elisp-in-header-arguments ()
158 "Test execution of elisp forms in header arguments."
159 ;; at the babel.org:elisp-forms-in-header-arguments header
160 (org-test-at-id "22d67284-bf14-4cdc-8319-f4bd876829d7"
161 (org-babel-next-src-block)
162 (let ((info (org-babel-get-src-block-info)))
163 (should (= 4 (org-babel-execute-src-block))))))
165 (ert-deftest test-org-babel/simple-named-code-block ()
166 "Test that simple named code blocks can be evaluated."
167 (org-test-at-id "0d82b52d-1bb9-4916-816b-2c67c8108dbb"
168 (org-babel-next-src-block 1)
169 (should (= 42 (org-babel-execute-src-block)))))
171 (ert-deftest test-org-babel/simple-variable-resolution ()
172 "Test that simple variable resolution is working."
173 (org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
174 (org-babel-next-src-block 2)
175 (should (= 4 (org-babel-execute-src-block)))))
177 (ert-deftest test-org-babel/multi-line-header-arguments ()
178 "Test that multi-line header arguments and can be read."
179 (org-test-at-id "b77c8857-6c76-4ea9-8a61-ddc2648d96c4"
180 (org-babel-next-src-block)
181 (let ((results (org-babel-execute-src-block)))
182 (should(equal 'a (cadr (assoc 1 results))))
183 (should(equal 'd (cadr (assoc 4 results)))))))
185 (ert-deftest test-org-babel/parse-header-args ()
186 (org-test-at-id "7eb0dc6e-1c53-4275-88b3-b22f3113b9c3"
187 (org-babel-next-src-block)
188 (let* ((info (org-babel-get-src-block-info))
189 (params (nth 2 info)))
190 (message "%S" params)
191 (should(equal "example-lang" (nth 0 info)))
192 (should(string= "the body" (org-babel-trim (nth 1 info))))
193 (should-not (member '(:session\ \ \ \ ) params))
194 (should(equal '(:session) (assoc :session params)))
195 (should(equal '(:result-type . output) (assoc :result-type params)))
196 (should(equal '(num . 9) (cdr (assoc :var params)))))))
198 (ert-deftest test-org-babel/parse-header-args2 ()
199 (org-test-at-id "2409e8ba-7b5f-4678-8888-e48aa02d8cb4"
200 (should (string-match (regexp-quote "this is simple")
201 (org-babel-ref-resolve "simple-subtree")))
202 (org-babel-next-src-block)
203 (should (= 14 (org-babel-execute-src-block)))))
205 (ert-deftest test-org-babel/inline-src-blocks ()
206 (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
207 (macrolet ((at-next (&rest body)
208 `(progn
209 (move-end-of-line 1)
210 (re-search-forward org-babel-inline-src-block-regexp nil t)
211 (goto-char (match-beginning 1))
212 (save-match-data ,@body))))
213 (at-next (should (equal 1 (org-babel-execute-src-block))))
214 (at-next (should (equal 2 (org-babel-execute-src-block))))
215 (at-next (should (equal 3 (org-babel-execute-src-block)))))))
217 (ert-deftest test-org-babel/org-babel-get-inline-src-block-matches ()
218 (org-test-at-id "0D0983D4-DE33-400A-8A05-A225A567BC74"
219 (let ((test-point (point)))
220 (should (fboundp 'org-babel-get-inline-src-block-matches))
221 (should (re-search-forward "src_" nil t)) ;; 1
222 (should (= (+ test-point 140) (match-end 0)))
223 (should (org-babel-get-inline-src-block-matches))
224 (should (re-search-forward "}" nil (point-at-bol))) ;; 1
225 (should-not (org-babel-get-inline-src-block-matches))
226 (should (re-search-forward "in" nil t)) ;; 2
227 (should-not (org-babel-get-inline-src-block-matches))
228 (should (re-search-forward "echo" nil t)) ;; 2
229 (should (org-babel-get-inline-src-block-matches))
230 (should (re-search-forward "blocks" nil t)) ;; 3
231 (backward-char 8) ;; 3
232 (should (org-babel-get-inline-src-block-matches))
233 (forward-char 1) ;;3
234 (should-not (org-babel-get-inline-src-block-matches))
235 (should (re-search-forward ":results" nil t)) ;; 4
236 (should (org-babel-get-inline-src-block-matches))
237 (end-of-line)
238 (should-not (org-babel-get-inline-src-block-matches))
241 (ert-deftest test-org-babel/inline-src_blk-default-results-replace-line-1 ()
242 (let ((test-line "src_sh{echo 1}"))
243 ;; src_ at bol line 1...
244 (org-test-with-temp-text
245 test-line
246 (goto-char (point-min)) (org-ctrl-c-ctrl-c)
247 (should (string=
248 (concat test-line " =1=")
249 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
250 (forward-char) (org-ctrl-c-ctrl-c)
251 (should (string=
252 (concat test-line " =1= =1=")
253 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
254 (re-search-forward "1}")
255 (should-error (org-ctrl-c-ctrl-c))
256 (backward-char) ;; last char of block body
257 (org-ctrl-c-ctrl-c)
258 (should (string=
259 (concat test-line " =1= =1= =1=")
260 (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))
261 ;; src_ follows space line 1...
262 (let ((test-line " src_emacs-lisp{ 1 }"))
263 (org-test-with-temp-text
264 test-line
265 (should-error (org-ctrl-c-ctrl-c))
266 (forward-char) (org-ctrl-c-ctrl-c)
267 (should (string=
268 (concat test-line " =1=")
269 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
270 (re-search-forward "{ 1 ") (org-ctrl-c-ctrl-c)
271 (should (string=
272 (concat test-line " =1= =1=")
273 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
274 (forward-char)
275 (should-error (org-ctrl-c-ctrl-c)))))
277 (ert-deftest test-org-babel/inline-src_blk-default-results-replace-line-2 ()
278 ;; src_ at bol line 2...
279 (let ((test-line " src_emacs-lisp{ \"x\" }"))
280 (org-test-with-temp-text
281 (concat "\n" test-line)
282 (should-error (org-ctrl-c-ctrl-c))
283 (goto-char (point-min))
284 (should-error (org-ctrl-c-ctrl-c))
285 (forward-line)
286 (should-error (org-ctrl-c-ctrl-c))
287 (forward-char) (org-ctrl-c-ctrl-c)
288 (should (string=
289 (concat test-line " =x=")
290 (buffer-substring-no-properties
291 (point-at-bol) (point-at-eol))))))
293 (let ((test-line "Some text prior to block src_emacs-lisp{ \"y\" }"))
294 (org-test-with-temp-text
295 test-line
296 (goto-char (point-max))
297 (insert (concat "\n" test-line " end"))
298 (re-search-backward "src") (org-ctrl-c-ctrl-c)
299 (should (string=
300 (concat test-line " =y= end")
301 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
302 (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
303 (should (string=
304 (concat test-line " =y= =y= end")
305 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
306 (forward-char)
307 (should-error (org-ctrl-c-ctrl-c))))))
309 (ert-deftest test-org-babel/inline-src_blk-manual-results-replace ()
310 (let ((test-line " src_emacs-lisp[:results replace]{ \"x\" }"))
311 (org-test-with-temp-text
312 (concat "\n" test-line)
313 (should-error (org-ctrl-c-ctrl-c))
314 (goto-char (point-max))
315 (should-error (org-ctrl-c-ctrl-c))
316 (beginning-of-line)
317 (should-error (org-ctrl-c-ctrl-c))
318 (forward-char) (org-ctrl-c-ctrl-c)
319 (should (string=
320 (concat test-line " =x=")
321 (buffer-substring-no-properties
322 (point-at-bol) (point-at-eol))))))
324 (let ((test-line (concat " Some text prior to block "
325 "src_emacs-lisp[:results replace]{ \"y\" }")))
326 (org-test-with-temp-text test-line
327 (goto-char (point-max))
328 (insert (concat "\n" test-line " end"))
329 (re-search-backward "src") (org-ctrl-c-ctrl-c)
330 (should (string=
331 (concat test-line " =y= end")
332 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
333 (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
334 (should (string=
335 (concat test-line " =y= =y= end")
336 (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
337 (forward-char)
338 (should-error (org-ctrl-c-ctrl-c)))))
340 (ert-deftest test-org-babel/inline-src_blk-results-silent ()
341 (let ((test-line "src_emacs-lisp[ :results silent ]{ \"x\" }"))
342 (org-test-with-temp-text test-line
343 (org-ctrl-c-ctrl-c)
344 (should (string= test-line
345 (buffer-substring-no-properties
346 (point-at-bol) (point-at-eol))))
347 (end-of-buffer)
348 (should-error (org-ctrl-c-ctrl-c))))
349 (let ((test-line (concat " Some text prior to block src_emacs-lisp"
350 "[ :results silent ]{ \"y\" }")))
351 (org-test-with-temp-text
352 test-line
353 (goto-char (point-max))
354 (insert (concat "\n" test-line " end"))
355 (re-search-backward "src_") (org-ctrl-c-ctrl-c)
356 (should (string= (concat test-line " end")
357 (buffer-substring-no-properties
358 (point-at-bol) (point-at-eol))))
359 (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
360 (should (string= (concat test-line " end")
361 (buffer-substring-no-properties
362 (point-at-bol) (point-at-eol))))
363 (forward-char)
364 (should-error (org-ctrl-c-ctrl-c)))))
366 (ert-deftest test-org-babel/inline-src_blk-results-raw ()
367 (let ((test-line "src_emacs-lisp[ :results raw ]{ \"x\" }"))
368 (org-test-with-temp-text test-line
369 (org-ctrl-c-ctrl-c)
370 (should (string= (concat test-line " x")
371 (buffer-string)))))
372 (let ((test-line (concat " Some text prior to block "
373 "src_emacs-lisp[ :results raw ]{ \"the\" }")))
374 (org-test-with-temp-text (concat test-line " end")
375 (re-search-forward "src_") (org-ctrl-c-ctrl-c)
376 (should (string= (concat test-line " the end")
377 (buffer-substring-no-properties
378 (point-at-bol) (point-at-eol))))
379 (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
380 (should (string= (concat test-line " the the end")
381 (buffer-substring-no-properties
382 (point-at-bol) (point-at-eol))))
383 (forward-char)
384 (should-error (org-ctrl-c-ctrl-c)))))
386 (ert-deftest test-org-babel/inline-src_blk-results-file ()
387 (let ((test-line "src_emacs-lisp[ :results file ]{ \"~/test-file\" }"))
388 (org-test-with-temp-text
389 test-line
390 (org-ctrl-c-ctrl-c)
391 (should (string= (concat test-line " [[file:~/test-file]]")
392 (buffer-substring-no-properties
393 (point-min) (point-max)))))))
395 (ert-deftest test-org-babel/inline-src_blk-results-scalar ()
396 (let ((test-line "src_emacs-lisp[ :results scalar ]{ \"x\" }"))
397 (org-test-with-temp-text
398 test-line
399 (org-ctrl-c-ctrl-c)
400 (should (string= (concat test-line " =\"x\"=")
401 (buffer-substring-no-properties
402 (point-min) (point-max)))))))
404 (ert-deftest test-org-babel/inline-src_blk-results-verbatim ()
405 (let ((test-line "src_emacs-lisp[ :results verbatim ]{ \"x\" }"))
406 (org-test-with-temp-text
407 test-line
408 (org-ctrl-c-ctrl-c)
409 (should (string= (concat test-line " =\"x\"=")
410 (buffer-substring-no-properties
411 (point-min) (point-max)))))))
413 (ert-deftest test-org-babel/combining-scalar-and-raw-result-types ()
414 (flet ((next-result ()
415 (org-babel-next-src-block)
416 (org-babel-execute-src-block)
417 (goto-char (org-babel-where-is-src-block-result))
418 (forward-line 1)))
419 (org-test-at-id "a73a2ab6-b8b2-4c0e-ae7f-23ad14eab7bc"
420 (next-result)
421 (should (org-babel-in-example-or-verbatim))
422 (next-result)
423 (should (not (org-babel-in-example-or-verbatim))))))
425 (ert-deftest test-org-babel/no-defaut-value-for-var ()
426 "Test that the absence of a default value for a variable DOES THROW
427 a proper error."
428 (org-test-at-id "f2df5ba6-75fa-4e6b-8441-65ed84963627"
429 (org-babel-next-src-block)
430 (let ((err
431 (should-error (org-babel-execute-src-block) :type 'error)))
432 (should
433 (equal
434 '(error
435 "variable \"x\" in block \"carre\" must be assigned a default value")
436 err)))))
438 (ert-deftest test-org-babel/just-one-results-block ()
439 "Test that evaluating two times the same code block does not result in a
440 duplicate results block."
441 (org-test-with-temp-text "#+begin_src sh\necho Hello\n#+end_src\n"
442 (org-babel-execute-src-block)
443 (org-babel-execute-src-block) ; second code block execution
444 (should (search-forward "Hello")) ; the string inside the source code block
445 (should (search-forward "Hello")) ; the same string in the results block
446 (should-error (search-forward "Hello"))))
448 (provide 'test-ob)
450 ;;; test-ob ends here