daniel/emacs-conf
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

add lisp packages

Browse Source
This commit is contained in:
Daniel Weschke
2020-12-05 21:29:49 +01:00
parent 85e20365ae
commit a6e2395755
7272 changed files with 1363243 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

157
lisp/org/testing/README Normal file
View File

@@ -0,0 +1,157 @@
# -*- mode:org -*-
#+TITLE: Org mode Testing
#+PROPERTY: header-args:emacs-lisp :results silent
* Dependencies
The only dependency is [[http://www.emacswiki.org/emacs/ErtTestLibrary][ERT]] the Emacs testing library which ships with
Emacs24. If you are running an older version of Emacs and don't
already have ERT installed it can be installed from its old [[https://github.com/ohler/ert][git
repository]].
* Non-interactive batch testing from the command line
The simplest way to run the Org mode test suite is from the command
line with the following invocation. Note that the paths below are
relative to the base of the Org mode directory.
Also note that many of the current tests uses babel evaluation...
#+BEGIN_SRC sh :dir (expand-file-name "..")
# For Emacs earlier than 24, add -L /path/to/ert
emacs -Q --batch \
-L lisp/ -L testing/ -L testing/lisp -l lisp/org.el \
-l lisp/org-id.el -l testing/org-test.el \
--eval "(progn (org-reload) (setq org-confirm-babel-evaluate nil) \
(org-babel-do-load-languages 'org-babel-load-languages \
'((emacs-lisp . t) (shell . t) (org . t))))" \
-f org-test-run-batch-tests
#+END_SRC
The options in the above command are explained below.
| -Q | ignores any personal configuration ensuring a vanilla Emacs instance is used |
| --batch | runs Emacs in "batch" mode with no gui and termination after execution |
| -l | loads Org mode and the Org mode test suite defined in testing/org-test.el |
| --eval | reloads Org mode and allows evaluation of code blocks by the tests |
| -f | actually runs the tests using the `org-test-run-batch-tests' function |
* Trigger the tests with 'make'
** Recompile all
Target ~test~ can be used to trigger a test run. The tests start
after cleaning up and recompilation.
#+BEGIN_SRC sh :dir (expand-file-name "..") :results silent
make test
#+END_SRC
See ../mk/default.mk for details.
** Test dirty
The 'dirty' targets are for recompiling without cleaning and
rebuilding everything. This usually speeds up the recompilation
considerably. Note that this speed up comes to the price of possibly
weird errors due to the unclean build.
The dirty target for testing is called ~test-dirty~.
#+BEGIN_SRC sh :dir (expand-file-name "..") :results silent
make test-dirty
#+END_SRC
** Select tests by regexp
Variable ~BTEST_RE~ can be set to limit the tests which are performed.
~BTEST_RE~ is interpreted as regexp.
Example:
#+begin_src shell
make BTEST_RE='test-.*-inlinetask' test-dirty
#+end_src
yields
#+begin_example
...
selected tests: test-.*-inlinetask
Running 2 tests (2017-12-28 15:04:45+0100)
passed 1/2 test-org-export/handle-inlinetasks
passed 2/2 test-org-inlinetask/goto-end
Ran 2 tests, 2 results as expected (2017-12-28 15:04:45+0100)
...
#+end_example
* Interactive testing from within Emacs
To run the Org mode test suite from a current Emacs instance simply
load and run the test suite with the following commands.
1) First load the test suite.
#+BEGIN_SRC emacs-lisp :var here=(buffer-file-name)
(add-to-list 'load-path (file-name-directory here))
(require 'org-test)
#+END_SRC
2) Load required Babel languages
#+BEGIN_SRC emacs-lisp
(org-babel-do-load-languages
'org-babel-load-languages
(and
(mapc (lambda (lang) (add-to-list 'org-babel-load-languages (cons lang t)))
'(emacs-lisp shell org))
org-babel-load-languages))
#+END_SRC
3) Then run the test suite. Babel evaluation confirmation is disabled
and ~C-c C-c~ is enabled while running the tests.
#+BEGIN_SRC emacs-lisp
(let (org-babel-no-eval-on-ctrl-c-ctrl-c
org-confirm-babel-evaluate)
(org-test-run-all-tests))
#+END_SRC
When a test fails, run it interactively and investigate the problem
in the ERT results buffer.
To run one test: Use this as a demo example of a failing test
#+BEGIN_SRC emacs-lisp
(ert-deftest test-org/org-link-encode-ascii-character-demo-of-fail ()
(should (string= "%5B" ; Expecting %5B is correct.
(org-link-encode "[")))
(should (string= "%5C" ; Expecting %5C is wrong, %5D correct.
(org-link-encode "]"))))
#+END_SRC
or evaluate the ~ert-deftest form~ of the test you want to run.
Then ~M-x ert RET
test-org/org-link-encode-ascii-character-demo-of-fail RET~. When
not visible yet switch to the ERT results buffer named ~*ert*~.
When a test failed the ERT results buffer shows the details of the
first ~should~ that failed. See ~(info "(ert)Running Tests
Interactively")~ on how to re-run, start the debugger etc.
To run several tests: ~M-x ert RET "<your regexp here>" RET~.
To run all tests of a single test file: ~M-x ert-delete-all-tests
RET~ and confirm. ~M-x load-file RET testing/lisp/<file>.el RET
M-x ert RET t RET~.
Consider to set
#+BEGIN_SRC emacs-lisp
(setq pp-escape-newlines nil)
#+END_SRC
before running the test when looking at ~should~ in the ERT results
buffer. Especially when using ~l~ to look at passed test results
and possibly missing an appropriate setting of ~pp-escape-newlines~
made only temporarily for the running time of the test as
e. g. tests using ~org-test-table-target-expect-tblfm~ do.
* Troubleshooting
- If the variable ~org-babel-no-eval-on-ctrl-c-ctrl-c~ is non-nil then
it will result in some test failure, as there are tests which rely
on this behavior.

8
lisp/org/testing/examples/agenda-file.org Normal file
View File

@@ -0,0 +1,8 @@
* Test Agenda
<2017-03-10 Fri>
* test agenda
SCHEDULED: <2017-07-19 Wed>
** subnote
* test code 216bc1ff1d862e78183e38ee9a4da504919b9878
<2019-01-08 Tue>

1
lisp/org/testing/examples/att1/fileA Normal file
View File

@@ -0,0 +1 @@
Text in fileA

1
lisp/org/testing/examples/att1/fileB Normal file
View File

@@ -0,0 +1 @@
Text in fileB

1
lisp/org/testing/examples/att2/fileC Normal file
View File

@@ -0,0 +1 @@
Text in fileC

1
lisp/org/testing/examples/att2/fileD Normal file
View File

@@ -0,0 +1 @@
text in fileD

32
lisp/org/testing/examples/attachments.org Normal file
View File

@@ -0,0 +1,32 @@
#+TITLE: Org attach testfile
Used to test and verify the functionality of org-attach.
* H1
:PROPERTIES:
:DIR: att1
:END:
A link to one attachment: [[attachment:fileA]]
** H1.1
A link to another attachment: [[attachment:fileB]]
** H1.2
:PROPERTIES:
:DIR: att2
:END:
* H2
:PROPERTIES:
:ID: abcd123
:END:
* H3
:PROPERTIES:
:DIR: att1
:ID: abcd1234
:END:
** H3.1
:PROPERTIES:
:ID: abcd12345
:END:

15
lisp/org/testing/examples/babel-dangerous.org Normal file
View File

@@ -0,0 +1,15 @@
#+Title: dangerous code block examples which should be isolated
#+OPTIONS: ^:nil
* no default value for vars
:PROPERTIES:
:ID: f2df5ba6-75fa-4e6b-8441-65ed84963627
:END:
There is no default value assigned to =x= variable. This is not permitted
anymore.
#+name: carre
#+begin_src python :var x
return x*x
#+end_src

490
lisp/org/testing/examples/babel.org Normal file
View File

@@ -0,0 +1,490 @@
#+Title: a collection of examples for Babel tests
#+OPTIONS: ^:nil
* =:noweb= header argument expansion
:PROPERTIES:
:ID: eb1f6498-5bd9-45e0-9c56-50717053e7b7
:END:
#+name: noweb-example
#+begin_src emacs-lisp :results silent :exports code
(message "expanded1")
#+end_src
#+name: noweb-example2
#+begin_src emacs-lisp :results silent
(message "expanded2")
#+end_src
#+begin_src emacs-lisp :noweb yes :results silent
;; noweb-1-yes-start
<<noweb-example>>
#+end_src
#+begin_src emacs-lisp :noweb no :results silent
;; noweb-no-start
<<noweb-example1>>
#+end_src
#+begin_src emacs-lisp :noweb yes :results silent
;; noweb-2-yes-start
<<noweb-example2>>
#+end_src
#+begin_src emacs-lisp :noweb tangle :results silent
;; noweb-tangle-start
<<noweb-example1>>
<<noweb-example2>>
#+end_src
* =:noweb= header argument expansion using :exports results
:PROPERTIES:
:ID: 8701beb4-13d9-468c-997a-8e63e8b66f8d
:END:
#+name: noweb-example
#+begin_src emacs-lisp :exports results
(message "expanded1")
#+end_src
#+name: noweb-example2
#+begin_src emacs-lisp :exports results
(message "expanded2")
#+end_src
#+begin_src emacs-lisp :noweb yes :exports results
;; noweb-1-yes-start
<<noweb-example>>
#+end_src
#+begin_src emacs-lisp :noweb no :exports code
;; noweb-no-start
<<noweb-example1>>
#+end_src
#+begin_src emacs-lisp :noweb yes :exports results
;; noweb-2-yes-start
<<noweb-example2>>
#+end_src
#+begin_src emacs-lisp :noweb tangle :exports code
<<noweb-example1>>
<<noweb-example2>>
#+end_src
* excessive id links on tangling
:PROPERTIES:
:ID: ef06fd7f-012b-4fde-87a2-2ae91504ea7e
:END:
** no, don't give me an ID
#+begin_src emacs-lisp :tangle no
(message "not to be tangled")
#+end_src
** yes, I'd love an ID
:PROPERTIES:
:ID: ae7b55ca-9ef2-4d30-bd48-da30e35fd0f3
:END:
#+begin_src emacs-lisp :tangle no
(message "for tangling")
#+end_src
* simple named code block
:PROPERTIES:
:ID: 0d82b52d-1bb9-4916-816b-2c67c8108dbb
:END:
#+name: i-have-a-name
#+begin_src emacs-lisp
42
#+end_src
#+name:
: 42
#+name: i-have-a-name
: 42
* Pascal's Triangle -- exports both test
:PROPERTIES:
:ID: 92518f2a-a46a-4205-a3ab-bcce1008a4bb
:END:
#+name: pascals-triangle
#+begin_src emacs-lisp :var n=5 :exports both
(defun pascals-triangle (n)
(if (= n 0)
(list (list 1))
(let* ((prev-triangle (pascals-triangle (- n 1)))
(prev-row (car (reverse prev-triangle))))
(append prev-triangle
(list (cl-map 'list #'+
(append prev-row '(0))
(append '(0) prev-row)))))))
(pascals-triangle n)
#+end_src
* calling code blocks from inside table
:PROPERTIES:
:ID: 6d2ff4ce-4489-4e2a-9c65-e3f71f77d975
:END:
#+name: take-sqrt
#+begin_src emacs-lisp :var n=9
(sqrt n)
#+end_src
* executing an lob call line
:PROPERTIES:
:header-args: :results silent
:ID: fab7e291-fde6-45fc-bf6e-a485b8bca2f0
:END:
#+call: echo(input="testing")
#+call: echo(input="testing") :results vector
#+call: echo[:var input="testing"]()
#+call: echo[:var input="testing"]() :results vector
#+call: echo("testing")
#+call: echo("testing") :results vector
This is an inline call call_echo(input="testing") embedded in prose.
This is an inline call call_echo(input="testing")[:results vector] embedded in prose.
#+call: lob-minus(8, 4)
call_echo("testing")
call_concat(1,2,3)
#+name: concat
#+begin_src emacs-lisp :var a=0 :var b=0 :var c=0
(format "%S%S%S" a b c)
#+end_src
* exporting an lob call line
:PROPERTIES:
:ID: 72ddeed3-2d17-4c7f-8192-a575d535d3fc
:END:
#+name: double
#+begin_src emacs-lisp :var it=0
(* 2 it)
#+end_src
The following exports as a normal call line
#+call: double(it=0)
Now here is an inline call call_double(it=1) stuck in the middle of
some prose.
This one should not be exported =call_double(it=2)= because it is
quoted.
Finally this next one should export, even though it starts a line
call_double(it=3) because sometimes inline blocks fold with a
paragraph.
And, a call with raw results call_double(4)[:results raw] should not
have quoted results.
The following 2*5=call_double(5) should export even when prefixed by
an = sign.
* inline source block
:PROPERTIES:
:ID: 54cb8dc3-298c-4883-a933-029b3c9d4b18
:END:
Here is one in the middle src_sh{echo 1} of a line.
Here is one at the end of a line. src_sh{echo 2}
src_sh{echo 3} Here is one at the beginning of a line.
* exported inline source block
:PROPERTIES:
:ID: cd54fc88-1b6b-45b6-8511-4d8fa7fc8076
:header-args: :exports code
:END:
Here is one in the middle src_sh{echo 1} of a line.
Here is one at the end of a line. src_sh{echo 2}
src_sh{echo 3} Here is one at the beginning of a line.
Here is one that is also evaluated: src_sh[:exports both]{echo 4}
* mixed blocks with exports both
:PROPERTIES:
:ID: 5daa4d03-e3ea-46b7-b093-62c1b7632df3
:END:
#+name: a-list
- a
- b
- c
#+begin_src emacs-lisp :exports both
"code block results"
#+end_src
#+begin_src emacs-lisp :var lst=a-list :results list :exports both
(reverse lst)
#+end_src
* using the =:noweb-ref= header argument
:PROPERTIES:
:ID: 54d68d4b-1544-4745-85ab-4f03b3cbd8a0
:header-args: :noweb-sep ""
:END:
#+begin_src sh :tangle yes :noweb yes :shebang "#!/bin/sh"
<<fullest-disk>>
#+end_src
** query all mounted disks
#+begin_src sh :noweb-ref fullest-disk
df
#+end_src
** strip the header row
#+begin_src sh :noweb-ref fullest-disk
|sed '1d'
#+end_src
** sort by the percent full
#+begin_src sh :noweb-ref fullest-disk
|awk '{print $5 " " $6}'|sort -n |tail -1
#+end_src
** extract the mount point
#+begin_src sh :noweb-ref fullest-disk
|awk '{print $2}'
#+end_src
* resolving sub-trees as references
:PROPERTIES:
:ID: 2409e8ba-7b5f-4678-8888-e48aa02d8cb4
:header-args: :results silent
:END:
#+begin_src emacs-lisp :var text=d4faa7b3-072b-4dcf-813c-dd7141c633f3
(length text)
#+end_src
#+begin_src org :noweb yes
<<simple-subtree>>
<<d4faa7b3-072b-4dcf-813c-dd7141c633f3>>
#+end_src
** simple subtree with custom ID
:PROPERTIES:
:CUSTOM_ID: simple-subtree
:END:
this is simple
** simple subtree with global ID
:PROPERTIES:
:ID: d4faa7b3-072b-4dcf-813c-dd7141c633f3
:END:
has length 14
* exporting a code block with a name
:PROPERTIES:
:ID: b02ddd8a-eeb8-42ab-8664-8a759e6f43d9
:END:
exporting a code block with a name
#+name: qux
#+begin_src sh :foo "baz"
echo bar
#+end_src
* noweb no-export and exports both
:PROPERTIES:
:ID: 8a820f6c-7980-43db-8a24-0710d33729c9
:END:
Weird interaction.
here is one block
#+name: noweb-no-export-and-exports-both-1
#+BEGIN_SRC sh :exports none
echo 1
#+END_SRC
and another
#+BEGIN_SRC sh :noweb no-export :exports both
# I am inside the code block
<<noweb-no-export-and-exports-both-1>>
#+END_SRC
* in order evaluation on export
:PROPERTIES:
:header-args: :exports results
:ID: 96cc7073-97ec-4556-87cf-1f9bffafd317
:END:
First.
#+name: foo-for-order-of-evaluation
#+begin_src emacs-lisp :var it=1
(push it *evaluation-collector*)
#+end_src
Second
#+begin_src emacs-lisp
(push 2 *evaluation-collector*)
#+end_src
Third src_emacs-lisp{(car (push 3 *evaluation-collector*))}
Fourth
#+call: foo-for-order-of-evaluation(4)
Fifth
#+begin_src emacs-lisp
(push 5 *evaluation-collector*)
#+end_src
* exporting more than just results from a call line
:PROPERTIES:
:ID: bec63a04-491e-4caa-97f5-108f3020365c
:END:
Here is a call line with more than just the results exported.
#+call: double(8)
* strip noweb references on export
:PROPERTIES:
:ID: 8e7bd234-99b2-4b14-8cd6-53945e409775
:END:
#+name: strip-export-1
#+BEGIN_SRC sh :exports none
i="10"
#+END_SRC
#+BEGIN_SRC sh :noweb strip-export :exports code :results silent
<<strip-export-1>>
echo "1$i"
#+END_SRC
* use case of reading entry properties
:PROPERTIES:
:ID: cc5fbc20-bca5-437a-a7b8-2b4d7a03f820
:END:
Use case checked and documented with this test: During their
evaluation the source blocks read values from properties from the
entry where the call has been made unless the value is overridden with
the optional argument of the caller.
** section
:PROPERTIES:
:a: 1
:c: 3
:END:
Note: Just export of a property can be done with a macro: {{{property(a)}}}.
#+NAME: src_block_location_shell-sect-call
#+CALL: src_block_location_shell()
#+NAME: src_block_location_elisp-sect-call
#+CALL: src_block_location_elisp()
- sect inline call_src_block_location_shell()[:results raw]
- sect inline call_src_block_location_elisp()[:results raw]
*** subsection
:PROPERTIES:
:b: 2
:c: 4
:END:
#+NAME: src_block_location_shell-sub0-call
#+CALL: src_block_location_shell()
#+NAME: src_block_location_elisp-sub0-call
#+CALL: src_block_location_elisp()
- sub0 inline call_src_block_location_shell()[:results raw]
- sub0 inline call_src_block_location_elisp()[:results raw]
#+NAME: src_block_location_shell-sub1-call
#+CALL: src_block_location_shell(c=5, e=6)
#+NAME: src_block_location_elisp-sub1-call
#+CALL: src_block_location_elisp(c=5, e=6)
- sub1 inline call_src_block_location_shell(c=5, e=6)[:results raw]
- sub1 inline call_src_block_location_elisp(c=5, e=6)[:results raw]
**** function definition
comments for ":var":
- The "or" is to deal with a property not present.
- The t is to get property inheritance.
#+NAME: src_block_location_shell
#+HEADER: :var a=(or (org-entry-get org-babel-current-src-block-location "a" t) "0")
#+HEADER: :var b=(or (org-entry-get org-babel-current-src-block-location "b" t) "0")
#+HEADER: :var c=(or (org-entry-get org-babel-current-src-block-location "c" t) "0")
#+HEADER: :var d=(or (org-entry-get org-babel-current-src-block-location "d" t) "0")
#+HEADER: :var e=(or (org-entry-get org-babel-current-src-block-location "e" t) "0")
#+BEGIN_SRC sh :shebang #!/bin/sh :exports results :results verbatim
printf "shell a:$a, b:$b, c:$c, d:$d, e:$e"
#+END_SRC
#+RESULTS: src_block_location_shell
#+NAME: src_block_location_elisp
#+HEADER: :var a='nil
#+HEADER: :var b='nil
#+HEADER: :var c='nil
#+HEADER: :var d='nil
#+HEADER: :var e='nil
#+BEGIN_SRC emacs-lisp :exports results
(setq
;; - The first `or' together with ":var <var>='nil" is to check for
;; a value bound from an optional call argument, in the examples
;; here: c=5, e=6
;; - The second `or' is to deal with a property not present
;; - The t is to get property inheritance
a (or a (string-to-number
(or (org-entry-get org-babel-current-src-block-location "a" t)
"0")))
b (or b (string-to-number
(or (org-entry-get org-babel-current-src-block-location "b" t)
"0")))
c (or c (string-to-number
(or (org-entry-get org-babel-current-src-block-location "c" t)
"0")))
d (or d (string-to-number
(or (org-entry-get org-babel-current-src-block-location "e" t)
"0")))
e (or e (string-to-number
(or (org-entry-get org-babel-current-src-block-location "d" t)
"0"))))
(format "elisp a:%d, b:%d, c:%d, d:%d, e:%d" a b c d e)
#+END_SRC
* =:file-ext= and =:output-dir= header args
:PROPERTIES:
:ID: 93573e1d-6486-442e-b6d0-3fedbdc37c9b
:END:
#+name: file-ext-basic
#+BEGIN_SRC emacs-lisp :file-ext txt
nil
#+END_SRC
#+name: file-ext-dir-relative
#+BEGIN_SRC emacs-lisp :file-ext txt :output-dir foo
nil
#+END_SRC
#+name: file-ext-dir-relative-slash
#+BEGIN_SRC emacs-lisp :file-ext txt :output-dir foo/
nil
#+END_SRC
#+name: file-ext-dir-absolute
#+BEGIN_SRC emacs-lisp :file-ext txt :output-dir /tmp
nil
#+END_SRC
#+name: file-ext-file-wins
#+BEGIN_SRC emacs-lisp :file-ext txt :file foo.bar
nil
#+END_SRC
#+name: output-dir-and-file
#+BEGIN_SRC emacs-lisp :output-dir xxx :file foo.bar
nil
#+END_SRC

1
lisp/org/testing/examples/data/ab/cd123/fileE Normal file
View File

@@ -0,0 +1 @@
peek-a-boo

1
lisp/org/testing/examples/diary-file Normal file
View File

@@ -0,0 +1 @@
2019-01-08 test code: f0bcf0cd8bad93c1451bb6e1b2aaedef5cce7cbb

1
lisp/org/testing/examples/include.html Normal file
View File

@@ -0,0 +1 @@
<p>HTML!</p>

35
lisp/org/testing/examples/include.org Normal file
View File

@@ -0,0 +1,35 @@
Small Org file with an include keyword.
#+BEGIN_SRC emacs-lisp :exports results
(+ 2 1)
#+END_SRC
#+INCLUDE: "include2.org"
* Heading
body
* Another heading
:PROPERTIES:
:CUSTOM_ID: ah
:END:
1
2
3
* A headline with a table
:PROPERTIES:
:CUSTOM_ID: ht
:END:
#+CAPTION: a table
#+NAME: tbl
| 1 |
* drawer-headline
:PROPERTIES:
:CUSTOM_ID: dh
:END:
:LOGBOOK:
drawer
:END:
content

1
lisp/org/testing/examples/include2.org Normal file
View File

@@ -0,0 +1 @@
Success!

10
lisp/org/testing/examples/link-in-heading.org Normal file
View File

@@ -0,0 +1,10 @@
this file has a link in it's heading, which can cause problems
* [[http://www.example.com][example]]
what a weird heading...
#+begin_src emacs-lisp
;; a8b1d111-eca8-49f0-8930-56d4f0875155
(message "my heading has a link")
#+end_src

28
lisp/org/testing/examples/links.org Normal file
View File

@@ -0,0 +1,28 @@
#+TITLE: Testing various links types
* Plain links
- https://orgmode.org
- [[https://orgmode.org][Org mode website]]
- mailto:bzg@gnu.org
* Links to files
- file:///home/
- [[file:normal.org][normal.org]]
- [[file:normal.org::3][normal.org (third line)]]
- file:normal.org::example
- file:normal.org::* top
- id:eaefc396-8943-4666-be6a-d5a1dbb05480
* External links
:PROPERTIES:
:ID: eaefc396-8943-4666-be6a-d5a1dbb05480
:END:
- info:Org
- [[info:org:External links]]
- [[shell:ls -l]]
- elisp:org-agenda
- [[elisp:(find-file-other-frame "normal.org")]]

2
lisp/org/testing/examples/macro-templates.org Normal file
View File

@@ -0,0 +1,2 @@
#+TITLE: Macro templates
#+MACRO: included-macro success

9
lisp/org/testing/examples/no-heading.org Normal file
View File

@@ -0,0 +1,9 @@
This is an example file for use by the Org mode tests.
This file is special because it has no headings, which can be
erroneously assumed by some code.
#+begin_src emacs-lisp :tangle no
;; 94839181-184f-4ff4-a72f-94214df6f5ba
(message "I am code")
#+end_src

28
lisp/org/testing/examples/normal.org Normal file
View File

@@ -0,0 +1,28 @@
#+TITLE: Example file
#+OPTIONS: num:nil ^:nil
#+STARTUP: hideblocks
This is an example file for use by the Org mode tests.
* top
** code block
:PROPERTIES:
:header-args: :tangle yes
:CUSTOM_ID: code-block-section
:END:
Here are a couple of code blocks.
#+begin_src emacs-lisp :tangle no
;; 94839181-184f-4ff4-a72f-94214df6f5ba
(message "I am code")
#+end_src
* accumulating properties in drawers
:PROPERTIES:
:header-args+: :var bar=2
:header-args: :var foo=1
:ID: 75282ba2-f77a-4309-a970-e87c149fe125
:END:
#+begin_src emacs-lisp :results silent
(list bar foo)
#+end_src

158
lisp/org/testing/examples/ob-C-test.org Normal file
View File

@@ -0,0 +1,158 @@
#+Title: a collection of examples for ob-C tests
#+OPTIONS: ^:nil
* Simple tests
:PROPERTIES:
:ID: fa6db330-e960-4ea2-ac67-94bb845b8577
:END:
#+source: simple
#+begin_src cpp :includes "<iostream>" :results silent
std::cout << 42;
return 0;
#+end_src
#+source: simple
#+begin_src D :results silent
writefln ("%s", 42);
#+end_src
#+source: integer_var
#+begin_src cpp :var q=12 :includes "<iostream>" :results silent
std::cout << q;
return 0;
#+end_src
#+source: integer_var
#+begin_src D :var q=12 :results silent
writefln ("%s", q);
#+end_src
#+source: two_var
#+begin_src cpp :var q=12 :var p=10 :includes "<iostream>" :results silent
std::cout << p+q;
return 0;
#+end_src
#+source: two_var
#+begin_src D :var q=12 :var p=10 :results silent
writefln ("%s", p+q);
#+end_src
#+source: string_var
#+begin_src cpp :var q="word" :includes '(<iostream> <cstring>) :results silent
std::cout << q << ' ' << std::strlen(q);
return 0;
#+end_src
#+source: string_var
#+begin_src D :var q="word" :results silent
writefln ("%s %s", q, q.length);
#+end_src
#+source: define
#+begin_src cpp :defines N 42 :includes "<iostream>" :results silent
std::cout << N;
return 0;
#+end_src
* Array
:PROPERTIES:
:ID: 2df1ab83-3fa3-462a-a1f3-3aef6044a874
:END:
#+source: array
#+begin_src cpp :includes "<iostream>" :results vector :results silent
for (int i=1; i<3; i++) {
std::cout << i << '\n';
}
return 0;
#+end_src
#+source: array
#+begin_src D :results vector :results silent
foreach (i; 1..3)
writefln ("%s", i);
#+end_src
* Matrix
:PROPERTIES:
:ID: cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5
:END:
#+name: C-matrix
| 1 | 2 |
| 3 | 4 |
#+source: list_var
#+begin_src cpp :var a='("abc" "def") :includes "<iostream>" :results silent
std::cout << a[0] << a[1] << sizeof(a)/sizeof(*a) << '\n';
#+end_src
#+source: list_var
#+begin_src D :var a='("abc" "def") :results silent
writefln ("%s%s%s", a[0], a[1], a.length);
#+end_src
#+source: vector_var
#+begin_src cpp :var a='[1 2] :includes "<iostream>" :results silent
std::cout << a[0] << a[1] << sizeof(a)/sizeof(*a) << '\n';
#+end_src
#+source: vector_var
#+begin_src D :var a='[1 2] :results silent
writefln ("%s%s%s", a[0], a[1], a.length);
#+end_src
#+source: list_list_var
#+begin_src cpp :var q=C-matrix :includes "<iostream>" :results silent
std::cout << q[0][0] << ' ' << q[1][0] << '\n'
<< q[0][1] << ' ' << q[1][1] << '\n'; // transpose
#+end_src
#+source: list_list_var
#+begin_src D :var q=C-matrix :results silent
writefln ("%s %s", q[0][0], q[1][0]);
writefln ("%s %s", q[0][1], q[1][1]); // transpose
#+end_src
* Inhomogeneous table
:PROPERTIES:
:ID: e112bc2e-419a-4890-99c2-7ac4779531cc
:END:
#+name: tinomogen
| day | quty |
|-----------+------|
| monday | 34 |
| tuesday | 41 |
| wednesday | 56 |
| thursday | 17 |
| friday | 12 |
| saturday | 7 |
| sunday | 4 |
#+source: inhomogeneous_table
#+begin_src cpp :var tinomogen=tinomogen :results silent :includes <string.h> <stdio.h>
int main()
{
int i, j;
for (i=0; i<tinomogen_rows; i++) {
for (j=0; j<tinomogen_cols; j++)
printf ("%s ", tinomogen[i][j]);
printf ("\n");
}
printf ("Friday %s\n", tinomogen_h(4,"day"));
return 0;
}
#+end_src
#+source: inhomogeneous_table
#+begin_src D :var tinomogen=tinomogen :results silent
import std.stdio;
void main()
{
for (int i=0; i<tinomogen_rows; i++) {
for (int j=0; j<tinomogen_cols; j++)
writef ("%s ", tinomogen[i][j]);
writeln();
}
writefln ("Friday %s\n", tinomogen_h(4,"day"));
}
#+end_src

2
lisp/org/testing/examples/ob-awk-test.in Normal file
View File

@@ -0,0 +1,2 @@
# an input file for awk test
15

46
lisp/org/testing/examples/ob-awk-test.org Normal file
View File

@@ -0,0 +1,46 @@
#+Title: a collection of examples for ob-awk tests
#+OPTIONS: ^:nil
* Simple tests
:PROPERTIES:
:ID: 9e998b2a-3581-43fe-b26d-07d3c507b86a
:END:
Run without input stream
#+begin_src awk :output silent :results silent
BEGIN {
print 42
}
#+end_src
Use a code block output as an input
#+begin_src awk :stdin genseq :results silent
{
print 42+$1
}
#+end_src
Use input file
#+name: genfile
#+begin_src awk :in-file ob-awk-test.in :results silent
$0~/[\t]*#/{
# skip comments
next
}
{
print $1*10
}
#+end_src
#+name: awk-table-input
| a | b | c |
#+begin_src awk :var a=awk-table-input
BEGIN{ print a; }
#+end_src
* Input data generators
A code block to generate input stream
#+name: genseq
#+begin_src emacs-lisp :results silent
(print "1")
#+end_src

108
lisp/org/testing/examples/ob-fortran-test.org Normal file
View File

@@ -0,0 +1,108 @@
#+Title: a collection of examples for ob-fortran tests
#+OPTIONS: ^:nil
* simple programs
:PROPERTIES:
:ID: 459384e8-1797-4f11-867e-dde0473ea7cc
:END:
#+name: hello
#+begin_src fortran :results silent
print *, 'Hello world'
#+end_src
#+name: fortran_parameter
#+begin_src fortran :results silent
integer, parameter :: i = 10
write (*, '(i2)') i
#+end_src
* variable resolution
:PROPERTIES:
:ID: d8d1dfd3-5f0c-48fe-b55d-777997e02242
:END:
#+begin_src fortran :var N = 15 :results silent
write (*, '(i2)') N
#+end_src
Define for preprocessed fortran
#+begin_src fortran :defines N 42 :results silent
implicit none
write (*, '(i2)') N
#+end_src
#+begin_src fortran :var s="word" :results silent
write (*, '(a4)') s
#+end_src
* arrays
:PROPERTIES:
:ID: c28569d9-04ce-4cad-ab81-1ea29f691465
:END:
Real array as input
#+begin_src fortran :var s='(1.0 2.0 3.0) :results silent
write (*, '(3f5.2)'), s
#+end_src
#+name: test_tbl
| 1.0 |
| 2.0 |
#+begin_src fortran :var s=test_tbl :results silent
write (*, '(2f5.2)'), s
#+end_src
* matrix
:PROPERTIES:
:ID: 3f73ab19-d25a-428d-8c26-e8c6aa933976
:END:
Real matrix as input
#+name: fortran-input-matrix1
| 0.0 | 42.0 |
| 0.0 | 0.0 |
| 0.0 | 0.0 |
#+name: fortran-input-matrix2
| 0.0 | 0.0 | 0.0 |
| 0.0 | 0.0 | 42.0 |
#+begin_src fortran :var s=fortran-input-matrix1 :results silent
write (*, '(i2)'), nint(s(1,2))
#+end_src
#+begin_src fortran :var s=fortran-input-matrix2 :results silent
write (*, '(i2)'), nint(s(2,3))
#+end_src
* failing
:PROPERTIES:
:ID: 891ead4a-f87a-473c-9ae0-1cf348bcd04f
:END:
Should fail (TODO: add input variables for the case with explicit
program statement)
#+begin_src fortran :var s="word" :results silent
program ex
print *, "output of ex program"
end program ex
#+end_src
Fails to compile (TODO: error check in ob-fortran.el)
#+begin_src fortran :var s='(1 ()) :results silent
print *, s
#+end_src
Should fail to compile with gfortran
#+begin_src fortran :flags --std=f95 --pedantic-error :results silent
program ex
integer*8 :: i
end program ex
#+end_src
* programs input parameters
:PROPERTIES:
:ID: 2d5330ea-9934-4737-9ed6-e1d3dae2dfa4
:END:
Pass parameters to the program
#+begin_src fortran :cmdline "23" :results silent
character(len=255) :: cmd
call get_command_argument(1, cmd)
write (*,*) trim(cmd)
#+end_src

112
lisp/org/testing/examples/ob-header-arg-defaults.org Normal file
View File

@@ -0,0 +1,112 @@
#+TITLE: Tests for default header arguments to Babel source blocks
#+OPTIONS: ^:nil
#+PROPERTY: header-args :var t1="gh1" t2="gh2_clobbered"
#+PROPERTY: header-args+ :var t4="gh4" t2="gh2" :var end=9
#+PROPERTY: header-args:emacs-lisp :var t1="ge1" t4="ge4_clobbered"
#+PROPERTY: header-args:emacs-lisp+ :var t4="ge4" :var t5="ge5"
#+PROPERTY: header-args:emacs-lisp+ :results silent :noweb yes
#+NAME: showvar
#+BEGIN_SRC emacs-lisp :execute no
(mapconcat (lambda (n)
(let* ((n (string (+ 48 n)))
(p (intern (concat "t" n))))
(if (boundp p) (eval p) (concat "--" n))))
(number-sequence 1 end)
"/")
#+END_SRC
* Global property
:PROPERTIES:
:ID: 3fdadb69-5d15-411e-aad0-f7860cdd7816
:END:
| Global | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args | gh1 | gh2 | --- | gh4 | --- | --- | --- | --- | --- |
| header-args:emacs-lisp | ge1 | --- | --- | ge4 | ge5 | --- | --- | --- | --- |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Result | ge1 | gh2 | --3 | ge4 | ge5 | --6 | --7 | --8 | --9 |
#+CALL: showvar() :results silent
#+BEGIN_SRC emacs-lisp :var end=7
<<showvar>>
#+END_SRC
* Tree property
** Overwrite
:PROPERTIES:
:ID: a9cdfeda-9f31-4bb5-b694-2cf452f07dfd
:header-args: :var t7="th7"
:header-args:emacs-lisp: :var t8="te8"
:header-args:emacs-lisp+: :results silent :noweb yes :var end=9
:END:
| Global | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args | gh1 | gh2 | --- | gh4 | --- | --- | --- | --- | --- |
| header-args:emacs-lisp | ge1 | --- | --- | ge4 | ge5 | --- | --- | --- | --- |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Tree | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args | --- | --- | --- | --- | --- | --- | th7 | --- | --- |
| header-args:emacs-lisp | --- | --- | --- | --- | --- | --- | --- | te8 | --- |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Result #+CALL | ge1 | gh2 | --3 | ge4 | ge5 | --6 | th7 | te8 | --9 |
| Result noweb | --1 | --2 | --3 | --4 | --5 | --6 | th7 | te8 | --9 |
#+CALL: showvar() :results silent
#+BEGIN_SRC emacs-lisp
<<showvar>>
#+END_SRC
** Accumulate
:PROPERTIES:
:ID: 1d97d258-fd50-4107-a095-e4625bffc57b
:header-args+: :var t2="th2" t3="th3"
:header-args:emacs-lisp+: :var t5="te5" end=8
:END:
| Global | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|-------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args | gh1 | gh2 | --- | gh4 | --- | --- | --- | --- | --- |
| header-args:emacs-lisp | ge1 | --- | --- | ge4 | ge5 | --- | --- | --- | --- |
|-------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Tree | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|-------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args+ | --- | th2 | th3 | --- | --- | --- | --- | --- | --- |
| header-args:emacs-lisp+ | --- | --- | --- | --- | te5 | --- | --- | --- | --- |
|-------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Result #+CALL | ge1 | th2 | th3 | ge4 | te5 | --6 | --7 | --8 | --9 |
| Result noweb | ge1 | th2 | th3 | ge4 | te5 | --6 | --7 | --8 | --9 |
#+CALL: showvar(end=6) :results silent
#+BEGIN_SRC emacs-lisp
<<showvar>>
#+END_SRC
** Complex
:PROPERTIES:
:ID: fa0e912d-d9b4-47b0-9f9e-1cbb39f7cbc2
:header-args+: :var t2="th2"
:header-args:emacs-lisp: :var t5="te5" end=7
:header-args:emacs-lisp+: :results silent :noweb yes :var end=9
:END:
| Global | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args | gh1 | gh2 | --- | gh4 | --- | --- | --- | --- | --- |
| header-args:emacs-lisp | ge1 | --- | --- | ge4 | ge5 | --- | --- | --- | --- |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Tree | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| header-args+ | --- | th2 | --- | --- | --- | --- | --- | --- | --- |
| header-args:emacs-lisp | --- | --- | --- | --- | te5 | --- | --- | --- | --- |
|------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
| Result #+CALL | gh1 | th2 | go3 | gh4 | te5 | --6 | --7 | --8 | --9 |
| Result noweb | gh1 | th2 | --3 | gh4 | te5 | --6 | --7 | --8 | --9 |
#+CALL: showvar(end=6) :results silent
#+BEGIN_SRC emacs-lisp
<<showvar>>
#+END_SRC

31
lisp/org/testing/examples/ob-lilypond-broken.ly Normal file
View File

@@ -0,0 +1,31 @@
line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8
line 9
line 10
line 11
line 12
line 13
line 14
line 15
line 16
line 17
line 18
line 19
line 20
line 21
line 22
line 23
line 24
line 25
line 26
line 27
line 28
line 29
line 30

39
lisp/org/testing/examples/ob-lilypond-broken.org Normal file
View File

@@ -0,0 +1,39 @@
* Faulty lilypond org file for test purposes (do not adjust)
line 2
line 3
line 4
line 5
line 6
line 7
line 8
line 9
line 10
line 11
line 12
line 13
line 14
line 15
line 16
line 17
line 18
line 19
line 20
line 21
line 22
line 23
line 24
line 25
line 26
line 27
line 28
line 29
line 30
line 31
line 32
line 33
line 34
line 35
line 36
line 37
line 38
line 39

15
lisp/org/testing/examples/ob-lilypond-test.error Normal file
View File

@@ -0,0 +1,15 @@
Processing `xxx'
Parsing...
/path/to/tangled/file/test.ly:25:0: error: syntax error, unexpected \score, expecting '='
\score {
Interpreting music... [8][16][24][32]
Preprocessing graphical objects...
Interpreting music...
MIDI output to `xxx'
Finding the ideal number of pages...
Fitting music on 2 or 3 pages...
Drawing systems...
Layout output to `xxx'
Converting to `xxx'...
error: failed files: "/Path/to/tangled/file/test.ly/example.ly"

30
lisp/org/testing/examples/ob-lilypond-test.ly Normal file
View File

@@ -0,0 +1,30 @@
% [[file:~/.emacs.d/martyn/martyn/ob-lilypond/test/test-build/test.org::*LilyPond%2520Version][LilyPond-Version:1]]
\version "2.12.3"
% LilyPond-Version:1 ends here
% [[file:~/.emacs.d/martyn/martyn/ob-lilypond/test/test-build/test.org::*lilypond%2520block%2520for%2520test%2520purposes][lilypond-block-for-test-purposes:1]]
\score {
\relative c' {
c8 d e f g a b c |
b a g f e d c4 |
}
% lilypond-block-for-test-purposes:1 ends here
% [[file:~/.emacs.d/martyn/martyn/ob-lilypond/test/test-build/test.org::*lilypond%2520block%2520for%2520test%2520purposes][lilypond-block-for-test-purposes:2]]
\layout {
}
\midi {
\context {
\Score
tempoWholesPerMinute = #(ly:make-moment 150 4)
}
}
}
% lilypond-block-for-test-purposes:2 ends here

37
lisp/org/testing/examples/ob-lilypond-test.org Normal file
View File

@@ -0,0 +1,37 @@
* Test org lilypond file
This is a simple file for test purposes
** LilyPond Version
#+begin_src lilypond
\version "2.12.3"
#+end_src
** DONE lilypond block for test purposes
#+begin_src lilypond
\score {
\relative c' {
c8 d e f g a b c |
b a g f e d c4 |
}
#+end_src
#+begin_src lilypond
\layout {
}
\midi {
\context {
\Score
tempoWholesPerMinute = #(ly:make-moment 150 4)
}
}
}
#+end_src

91
lisp/org/testing/examples/ob-maxima-test.org Normal file
View File

@@ -0,0 +1,91 @@
#+Title: a collection of examples for ob-maxima tests
#+OPTIONS: ^:nil
* Simple tests
:PROPERTIES:
:ID: b5842ed4-8e8b-4b18-a1c9-cef006b6a6c8
:END:
#+begin_src maxima :var s=4 :results silent
print(s);
#+end_src
Pass a string
#+begin_src maxima :var fun="sin(x)" :var q=2 :results silent
print(diff(fun, x, q))$
#+end_src
* Graphic output
Graphic output
#+begin_src maxima :var a=0.5 :results graphics :file maxima-test-sin.png
plot2d(sin(a*x), [x, 0, 2*%pi])$
#+end_src
#+begin_src maxima :results graphics :file maxima-test-3d.png
plot3d (2^(-u^2 + v^2), [u, -3, 3], [v, -2, 2])$
#+end_src
* Output to a file
Output to a file
#+begin_src maxima :file maxima-test-ouput.out
for i:1 thru 10 do print(i)$
#+end_src
* List input
:PROPERTIES:
:ID: b5561c6a-73cd-453a-ba5e-62ad84844de6
:END:
Simple list as an input
#+begin_src maxima :var a=(list 1 2 3) :results silent :results verbatim
print(a)$
#+end_src
#+begin_src maxima :var a=(list 1 (list 1 2) 3) :results silent :results verbatim
print(a+1);
#+end_src
* Table input
:PROPERTIES:
:ID: 400ee228-6b12-44fd-8097-7986f0f0db43
:END:
#+name: test_tbl_col
| 1.0 |
| 2.0 |
#+name: test_tbl_row
| 1.0 | 2.0 |
#+begin_src maxima :var s=test_tbl_col :results silent :results verbatim
print(s+1.0);
#+end_src
#+begin_src maxima :var s=test_tbl_row :results silent :results verbatim
print(s+1.0);
#+end_src
Matrix
#+name: test_tbl_mtr
| 1.0 | 1.0 |
#+begin_src maxima :var s=test_tbl_mtr :results silent :results verbatim
ms: apply(matrix, s);
print(ms);
#+end_src
* Construct a table from the output
:PROPERTIES:
:ID: cc158527-b867-4b1d-8ae0-b8c713a90fd7
:END:
#+begin_src maxima :results silent
with_stdout("/dev/null", load(numericalio))$
m: genmatrix (lambda([i,j], i+j-1), 3, 3)$
write_data(m, "/dev/stdout")$
#+end_src
* Latex output
#+begin_src maxima :exports both :results latex :results verbatim
assume(x>0);
tex(ratsimp(diff(%e^(a*x), x)));
#+end_src
#+results:
#+BEGIN_LaTeX
$$a\,e^{a\,x}$$
#+END_LaTeX

55
lisp/org/testing/examples/ob-octave-test.org Normal file
View File

@@ -0,0 +1,55 @@
#+Title: a collection of examples for ob-octave tests
#+OPTIONS: ^:nil
* Simple tests
:PROPERTIES:
:ID: 54dcd61d-cf6c-4d7a-b9e5-854953c8a753
:END:
Number output
#+begin_src octave :exports results :results silent
ans = 10
#+end_src
Array output
#+begin_src octave :exports results :results silent
ans = 1:4'
#+end_src
* Input tests
:PROPERTIES:
:ID: cc2d82bb-2ac0-45be-a0c8-d1463b86a3ba
:END:
Input an integer variable
#+begin_src octave :exports results :results silent :var s=42
ans = s
#+end_src
Input an array
#+begin_src octave :exports results :results silent :var s='(1.0 2.0 3.0)
ans = s
#+end_src
Input a matrix
#+begin_src octave :exports results :results silent :var s='((1 2) (3 4))
ans = s
#+end_src
Input a string
#+begin_src octave :exports results :results silent :var s="test"
ans = s(1:2)
#+end_src
Input elisp nil
#+begin_src octave :exports results :results silent :var s='nil
ans = s
#+end_src
* Graphical tests
#+begin_src octave :results graphics :file chart.png
sombrero;
#+end_src
#+begin_src octave :session
sombrero;
#+end_src

5
lisp/org/testing/examples/ob-screen-test.org Normal file
View File

@@ -0,0 +1,5 @@
#+Title: a collection of examples for ob-screen tests
#+begin_src screen :session create-tmpdir
mkdir -p $TMPDIR
cd $TMPDIR
#+end_src

35
lisp/org/testing/examples/ob-sed-test.org Normal file
View File

@@ -0,0 +1,35 @@
#+PROPERTY: results silent scalar
#+Title: a collection of examples for ob-sed tests
* Test simple execution of sed script
:PROPERTIES:
:ID: C7E7CA6A-2601-42C9-B534-4102D62E458D
:END:
#+NAME: ex1
#+BEGIN_EXAMPLE
An example sentence.
#+END_EXAMPLE
#+BEGIN_SRC sed :stdin ex1
s/n example/ processed/
2 d
#+END_SRC
* Test :in-file header argument
:PROPERTIES:
:ID: 54EC49AA-FE9F-4D58-812E-00FC87FAF562
:END:
#+BEGIN_SRC sed :in-file test1.txt
s/test/tested/
#+END_SRC
* Test :cmd-line header argument
:PROPERTIES:
:ID: E3C6A8BA-39FF-4840-BA8E-90D5C4365AB1
:END:
#+BEGIN_SRC sed :in-file test2.txt :cmd-line "-i"
s/test/tested again/
#+END_SRC

88
lisp/org/testing/examples/ob-shell-test.org Normal file
View File

@@ -0,0 +1,88 @@
#+Title: a collection of examples for ob-shell tests
#+OPTIONS: ^:nil
* Sample data structures
#+NAME: sample_array
| one |
| two |
| three |
#+NAME: sample_mapping_table
| first | one |
| second | two |
| third | three |
#+NAME: sample_big_table
| bread | 2 | kg |
| spaghetti | 20 | cm |
| milk | 50 | dl |
* Array tests
:PROPERTIES:
:ID: 0ba56632-8dc1-405c-a083-c204bae477cf
:END:
** Generic shell: no arrays
#+begin_src sh :exports results :var array=sample_array
echo ${array}
#+end_src
#+RESULTS:
: one two three
** Bash shell: support for arrays
Bash will see a simple indexed array. In this test, we check that the
returned value is indeed only the first item of the array, as opposed to
the generic serialiation that will return all elements of the array as
a single string.
#+begin_src bash :exports results :var array=sample_array
echo ${array}
#+end_src
#+RESULTS:
: one
* Associative array tests (simple map)
:PROPERTIES:
:ID: bec1a5b0-4619-4450-a8c0-2a746b44bf8d
:END:
** Generic shell: no special handing
The shell will see all values as a single string.
#+begin_src sh :exports results :var table=sample_mapping_table
echo ${table}
#+end_src
#+RESULTS:
: first one second two third three
** Bash shell: support for associative arrays
Bash will see a table that contains the first column as the 'index'
of the associative array, and the second column as the value.
#+begin_src bash :exports results :var table=sample_mapping_table
echo ${table[second]}
#+end_src
#+RESULTS:
: two
* Associative array tests (more than 2 columns)
:PROPERTIES:
:ID: 82320a48-3409-49d7-85c9-5de1c6d3ff87
:END:
** Generic shell: no special handing
#+begin_src sh :exports results :var table=sample_big_table
echo ${table}
#+end_src
#+RESULTS:
: bread 2 kg spaghetti 20 cm milk 50 dl
** Bash shell: support for associative arrays with lists
Bash will see an associative array that contains each row as a single
string. Bash cannot handle lists in associative arrays.
#+begin_src bash :exports results :var table=sample_big_table
echo ${table[spaghetti]}
#+end_src
#+RESULTS:
: 20 cm

14
lisp/org/testing/examples/org-exp.org Normal file
View File

@@ -0,0 +1,14 @@
#+Title: a collection of examples for export tests
#+OPTIONS: ^:nil
* stripping commas from within blocks on export
:PROPERTIES:
:ID: 76d3a083-67fa-4506-a41d-837cc48158b5
:END:
The following commas should not be removed.
#+begin_src r
a <- c(1
, 2
, 3)
#+end_src

25
lisp/org/testing/examples/property-inheritance.org Normal file
View File

@@ -0,0 +1,25 @@
#+property: header-args :var foo=1
#+property: header-args+ :var bar=2
#+begin_src emacs-lisp
(+ foo bar)
#+end_src
* overwriting a file-wide property
:PROPERTIES:
:header-args: :var foo=7
:END:
#+begin_src emacs-lisp
foo
#+end_src
* appending to a file-wide property
:PROPERTIES:
:header-args+: :var baz=3
:END:
#+begin_src emacs-lisp
(+ foo bar baz)
#+end_src

1
lisp/org/testing/examples/pub-symlink/link.org Normal file
View File

@@ -0,0 +1 @@
Symlink

9
lisp/org/testing/examples/pub/a.org Normal file
View File

@@ -0,0 +1,9 @@
#+title: A
#+date: <2014-03-04 Tue>
* Headline1
:PROPERTIES:
:CUSTOM_ID: a1
:END:
[[file:b.org::*Headline1]]

9
lisp/org/testing/examples/pub/b.org Normal file
View File

@@ -0,0 +1,9 @@
#+title: b
#+date: <2012-03-29 Thu>
* Headline1
:PROPERTIES:
:CUSTOM_ID: b1
:END:
[[file:a.org::#a1]]

1
lisp/org/testing/examples/pub/file.txt Normal file
View File

@@ -0,0 +1 @@
Text

1
lisp/org/testing/examples/pub/link Symbolic link
View File

@@ -0,0 +1 @@
../pub-symlink

1
lisp/org/testing/examples/pub/noextension Normal file
View File

@@ -0,0 +1 @@
No extension

2
lisp/org/testing/examples/pub/sub/c.org Normal file
View File

@@ -0,0 +1,2 @@
#+title: C
#+date: <2013-03-20 Wed>

1
lisp/org/testing/examples/setupfile.org Normal file
View File

@@ -0,0 +1 @@
#+SETUPFILE: subdir/setupfile2.org

6
lisp/org/testing/examples/setupfile3.org Normal file
View File

@@ -0,0 +1,6 @@
#+BIND: variable value
#+DESCRIPTION: l2
#+LANGUAGE: en
#+SELECT_TAGS: b
#+TITLE: b
#+PROPERTY: a 1

1
lisp/org/testing/examples/subdir/setupfile2.org Normal file
View File

@@ -0,0 +1 @@
#+SETUPFILE: ../setupfile3.org

179
lisp/org/testing/lisp/test-ob-C.el Normal file
View File

@@ -0,0 +1,179 @@
;;; test-ob-C.el --- tests for ob-C.el
;; Copyright (c) 2010-2014, 2019 Sergey Litvinov, Thierry Banel
;; Authors: Sergey Litvinov, Thierry Banel
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(unless (featurep 'ob-C)
(signal 'missing-test-dependency "Support for C code blocks"))
(ert-deftest ob-C/assert ()
(should t))
(ert-deftest ob-C/simple-program ()
"Hello world program."
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 1)
(should (= 42 (org-babel-execute-src-block))))))
(ert-deftest ob-D/simple-program ()
"Hello world program."
(if (executable-find org-babel-D-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 2)
(should (= 42 (org-babel-execute-src-block))))))
(ert-deftest ob-C/integer-var ()
"Test of an integer variable."
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 3)
(should (= 12 (org-babel-execute-src-block))))))
(ert-deftest ob-D/integer-var ()
"Test of an integer variable."
(if (executable-find org-babel-D-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 4)
(should (= 12 (org-babel-execute-src-block))))))
(ert-deftest ob-C/two-integer-var ()
"Test of two input variables"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 5)
(should (= 22 (org-babel-execute-src-block))))))
(ert-deftest ob-D/two-integer-var ()
"Test of two input variables"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 6)
(should (= 22 (org-babel-execute-src-block))))))
(ert-deftest ob-C/string-var ()
"Test of a string input variable"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 7)
(should (equal "word 4" (org-babel-execute-src-block))))))
(ert-deftest ob-D/string-var ()
"Test of a string input variable"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 8)
(should (equal "word 4" (org-babel-execute-src-block))))))
(ert-deftest ob-C/preprocessor ()
"Test of a string variable"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "fa6db330-e960-4ea2-ac67-94bb845b8577"
(org-babel-next-src-block 9)
(should (= 42 (org-babel-execute-src-block))))))
(ert-deftest ob-C/table ()
"Test of a table output"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "2df1ab83-3fa3-462a-a1f3-3aef6044a874"
(org-babel-next-src-block 1)
(should (equal '((1) (2)) (org-babel-execute-src-block))))))
(ert-deftest ob-D/table ()
"Test of a table output"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "2df1ab83-3fa3-462a-a1f3-3aef6044a874"
(org-babel-next-src-block 2)
(should (equal '((1) (2)) (org-babel-execute-src-block))))))
(ert-deftest ob-C/list-var ()
"Test of a list input variable"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
(org-babel-next-src-block 1)
(should (string= "abcdef2" (org-babel-execute-src-block))))))
(ert-deftest ob-D/list-var ()
"Test of a list input variable"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
(org-babel-next-src-block 2)
(should (string= "abcdef2" (org-babel-execute-src-block))))))
(ert-deftest ob-C/vector-var ()
"Test of a vector input variable"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
(org-babel-next-src-block 3)
(should (equal 122 (org-babel-execute-src-block))))))
(ert-deftest ob-D/vector-var ()
"Test of a vector input variable"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
(org-babel-next-src-block 4)
(should (equal 122 (org-babel-execute-src-block))))))
(ert-deftest ob-C/list-list-var ()
"Test of a list list input variable"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
(org-babel-next-src-block 5)
(should (equal '((1 3) (2 4)) (org-babel-execute-src-block))))))
(ert-deftest ob-D/list-list-var ()
"Test of a list list input variable"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
(org-babel-next-src-block 6)
(should (equal '((1 3) (2 4)) (org-babel-execute-src-block))))))
(ert-deftest ob-C/inhomogeneous_table ()
"Test inhomogeneous input table"
(if (executable-find org-babel-C++-compiler)
(org-test-at-id "e112bc2e-419a-4890-99c2-7ac4779531cc"
(org-babel-next-src-block 1)
(should (equal
'(("monday" 34)
("tuesday" 41)
("wednesday" 56)
("thursday" 17)
("friday" 12)
("saturday" 7)
("sunday" 4)
("Friday" "friday"))
(org-babel-execute-src-block))))))
(ert-deftest ob-D/inhomogeneous_table ()
"Test inhomogeneous input table"
(if (executable-find org-babel-D-compiler)
(org-test-at-id "e112bc2e-419a-4890-99c2-7ac4779531cc"
(org-babel-next-src-block 2)
(should (equal
'(("monday" 34)
("tuesday" 41)
("wednesday" 56)
("thursday" 17)
("friday" 12)
("saturday" 7)
("sunday" 4)
("Friday" "friday"))
(org-babel-execute-src-block))))))
;;; test-ob-C.el ends here

102
lisp/org/testing/lisp/test-ob-R.el Normal file
View File

@@ -0,0 +1,102 @@
;;; test-ob-R.el --- tests for ob-R.el
;; Copyright (c) 2011-2014, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "R")
(unless (featurep 'ess)
(signal 'missing-test-dependency "ESS"))
(unless (featurep 'ob-R)
(signal 'missing-test-dependency "Support for R code blocks"))
(ert-deftest test-ob-R/simple-session ()
(let (ess-ask-for-ess-directory ess-history-file)
(org-test-with-temp-text
"#+begin_src R :session R\n paste(\"Yep!\")\n#+end_src\n"
(should (string= "Yep!" (org-babel-execute-src-block))))))
(ert-deftest test-ob-R/colnames-yes-header-argument ()
(org-test-with-temp-text "#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames yes
#+header: :var x = eg
#+begin_src R
x
#+end_src"
(org-babel-next-src-block)
(should (equal '(("col") hline ("a") ("b"))
(org-babel-execute-src-block)))))
(ert-deftest test-ob-R/colnames-nil-header-argument ()
(org-test-with-temp-text "#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames nil
#+header: :var x = eg
#+begin_src R
x
#+end_src"
(org-babel-next-src-block)
(should (equal '(("col") hline ("a") ("b"))
(org-babel-execute-src-block)))))
(ert-deftest test-ob-R/colnames-no-header-argument ()
(org-test-with-temp-text "#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames no
#+header: :var x = eg
#+begin_src R
x
#+end_src"
(org-babel-next-src-block)
(should (equal '(("col") ("a") ("b"))
(org-babel-execute-src-block)))))
(ert-deftest test-ob-R/results-file ()
(let (ess-ask-for-ess-directory ess-history-file)
(org-test-with-temp-text
"#+NAME: TESTSRC
#+BEGIN_SRC R :results file
a <- file.path(\"junk\", \"test.org\")
a
#+END_SRC"
(goto-char (point-min)) (org-babel-execute-maybe)
(org-babel-goto-named-result "TESTSRC") (forward-line 1)
(should (string= "[[file:junk/test.org]]"
(buffer-substring-no-properties (point-at-bol) (point-at-eol))))
(goto-char (point-min)) (forward-line 1)
(insert "#+header: :session\n")
(goto-char (point-min)) (org-babel-execute-maybe)
(org-babel-goto-named-result "TESTSRC") (forward-line 1)
(should (string= "[[file:junk/test.org]]"
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))))))
(provide 'test-ob-R)
;;; test-ob-R.el ends here

48
lisp/org/testing/lisp/test-ob-awk.el Normal file
View File

@@ -0,0 +1,48 @@
;;; test-ob-awk.el --- tests for ob-awk.el
;; Copyright (c) 2010-2014, 2019 Sergey Litvinov
;; Authors: Sergey Litvinov
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "awk")
(unless (featurep 'ob-awk)
(signal 'missing-test-dependency "Support for Awk code blocks"))
(ert-deftest ob-awk/input-none ()
"Test with no input file"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-awk/input-src-block-1 ()
"Test a code block as an input"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block 2)
(should (= 43 (org-babel-execute-src-block)))))
(ert-deftest ob-awk/input-src-block-2 ()
"Test a code block as an input"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block 3)
(should (= 150 (org-babel-execute-src-block)))))
(ert-deftest ob-awk/tabular-input ()
"Test a code block as an input"
(org-test-at-id "9e998b2a-3581-43fe-b26d-07d3c507b86a"
(org-babel-next-src-block 4)
(should (equal '(("a" "b" "c")) (org-babel-execute-src-block)))))

91
lisp/org/testing/lisp/test-ob-clojure.el Normal file
View File

@@ -0,0 +1,91 @@
;;; test-ob-clojure.el
;; Copyright (c) 2018-2020 Free Software Foundation, Inc.
;; Authors: stardiviner
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;; Org tests for ob-clojure.el live here
;;; Code:
(org-test-for-executable "cider")
(unless (featurep 'cider)
(signal 'missing-test-dependency "CIDER"))
(unless (featurep 'ob-clojure)
(signal 'missing-test-dependency "Support for Clojure code blocks"))
(ert-deftest ob-clojure/simple-session ()
(org-test-with-temp-text
"#+begin_src clojure :session
(print \"hello, world\")
#+end_src
"
(should (string= "hello, world" (org-babel-execute-src-block)))))
(ert-deftest ob-clojure/initiate-session ()
(org-test-with-temp-text
"#+begin_src clojure :session :var a=1 :results output
(print \"hello, world\")
#+end_src
#+begin_src clojure :session :results output
(print a)
#+end_src"
(goto-char (point-min))
(org-babel-switch-to-session)
(sleep-for 2)
(org-babel-execute-maybe)
(org-babel-next-src-block)
(goto-char (org-babel-result-end))
(forward-line 2)
(should (string=
": 1"
(buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
(ert-deftest ob-clojure/initiate-session-with-var ()
(org-test-with-temp-text
"#+begin_src clojure :session :var a=1 :results output
(print a)
#+end_src"
(org-babel-next-src-block)
(org-babel-initiate-session)
(sleep-for 2)
(org-babel-execute-maybe)
(goto-char (org-babel-result-end))
(forward-line 2)
(should (string=
": 1"
(buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
(ert-deftest ob-clojure/tangle-without-ns ()
(org-test-with-temp-text
"#+begin_src clojure :tangle /tmp/test.clj
(print 1)
#+end_src"
(org-babel-next-src-block)
(org-babel-tangle)
(should
(string=
"(print 1)
"
(with-temp-buffer
(insert-file-contents "/tmp/test.clj")
(buffer-substring-no-properties (point-min) (point-max)))))))
(provide 'test-ob-clojure)
;;; test-ob-clojure.el ends here

170
lisp/org/testing/lisp/test-ob-emacs-lisp.el Normal file
View File

@@ -0,0 +1,170 @@
;;; test-ob-emacs-lisp.el
;; Copyright (c) 2012-2020 Free Software Foundation, Inc.
;; Authors: Eric Schulte, Martyn Jago
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;; Org tests for ob-emacs-lisp.el live here
;;; Code:
(ert-deftest ob-emacs-lisp/commented-last-block-line-no-var ()
(org-test-with-temp-text-in-file "
#+begin_src emacs-lisp
;;
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-maybe)
(should (re-search-forward "results:" nil t))
(forward-line)
(should
(string=
""
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))))
(org-test-with-temp-text-in-file "
#+begin_src emacs-lisp
\"some text\";;
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-maybe)
(should (re-search-forward "results:" nil t))
(forward-line)
(should
(string=
": some text"
(buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
(ert-deftest ob-emacs-lisp/commented-last-block-line-with-var ()
(org-test-with-temp-text-in-file "
#+begin_src emacs-lisp :var a=1
;;
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-maybe)
(re-search-forward "results" nil t)
(forward-line)
(should (string=
""
(buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
(ert-deftest ob-emacs-lisp/commented-last-block-line ()
(should
(string= ": 2"
(org-test-with-temp-text-in-file "
#+begin_src emacs-lisp :var a=2
2;;
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-maybe)
(re-search-forward "results" nil t)
(buffer-substring-no-properties (line-beginning-position 2)
(line-end-position 2))))))
(ert-deftest ob-emacs-lisp/dynamic-lexical-execute ()
(cl-flet ((execute (text)
(org-test-with-temp-text-in-file text
(org-babel-next-src-block)
(org-babel-execute-maybe)
(re-search-forward "results" nil t)
(re-search-forward ": " nil t)
(buffer-substring-no-properties (point) (point-at-eol)))))
(should (string= "dynamic" (execute "
#+begin_src emacs-lisp :lexical no :results verbatim
(let ((x 'dynamic)) (funcall (let ((x 'lexical)) (lambda () x))))
#+end_src")))
(should (string= "lexical" (execute "
#+begin_src emacs-lisp :lexical yes :results verbatim
(let ((x 'dynamic)) (funcall (let ((x 'lexical)) (lambda () x))))
#+end_src")))
(should (string= "dynamic" (let ((x 'dynamic)) (execute "
#+begin_src emacs-lisp :lexical no :results verbatim
x
#+end_src"))))
(should (string= "lexical" (let ((x 'dynamic)) (execute "
#+begin_src emacs-lisp :lexical '((x . lexical)) :results verbatim
x
#+end_src"))))
;; Src block execution uses `eval'. As of 2019-02-26, `eval' does
;; not dynamically bind `lexical-binding' to the value of its
;; LEXICAL parameter. Hence, (eval 'lexical-binding LEXICAL)
;; evaluates to the same value that just `lexical-binding'
;; evaluates to, even if LEXICAL is different. So tests like the
;; following do not work here:
;;
;; (should (string= "t" (execute "
;; #+begin_src emacs-lisp :lexical yes :results verbatim
;; lexical-binding
;; #+end_src")))
;;
;; However, the corresponding test in
;; `ob-emacs-lisp/dynamic-lexical-edit' does work.
))
(ert-deftest ob-emacs-lisp/dynamic-lexical-edit ()
(cl-flet ((execute (text)
(org-test-with-temp-text-in-file text
(org-babel-next-src-block)
(org-edit-src-code)
(goto-char (point-max))
(prog1 (eval-last-sexp 0)
(org-edit-src-exit)))))
(should (eq 'dynamic (execute "
#+begin_src emacs-lisp :lexical no :results verbatim
(let ((x 'dynamic)) (funcall (let ((x 'lexical)) (lambda () x))))
#+end_src")))
(should (eq 'lexical (execute "
#+begin_src emacs-lisp :lexical yes :results verbatim
(let ((x 'dynamic)) (funcall (let ((x 'lexical)) (lambda () x))))
#+end_src")))
(should (eq 'dynamic (let ((x 'dynamic)) (execute "
#+begin_src emacs-lisp :lexical no :results verbatim
x
#+end_src"))))
(should (eq 'lexical (let ((x 'dynamic)) (execute "
#+begin_src emacs-lisp :lexical '((x . lexical)) :results verbatim
x
#+end_src"))))
(should (equal nil (execute "
#+begin_src emacs-lisp :lexical no :results verbatim
lexical-binding
#+end_src")))
(should (equal t (execute "
#+begin_src emacs-lisp :lexical yes :results verbatim
lexical-binding
#+end_src")))
(should (equal '((x . 0)) (execute "
#+begin_src emacs-lisp :lexical '((x . 0)) :results verbatim
lexical-binding
#+end_src")))))
(provide 'test-ob-emacs-lisp)
;;; test-ob-emacs-lisp.el ends here

73
lisp/org/testing/lisp/test-ob-eshell.el Normal file
View File

@@ -0,0 +1,73 @@
;;; test-ob-eshell.el
;; Copyright (c) 2018 stardiviner
;; Authors: stardiviner
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comment:
;; Template test file for Org tests
;;; Code:
(unless (featurep 'ob-eshell)
(signal 'missing-test-dependency "Support for Eshell code blocks"))
(ert-deftest ob-eshell/execute ()
"Test ob-eshell execute."
(should
(string=
(org-test-with-temp-text
"#+begin_src eshell
echo 2
#+end_src"
(org-babel-execute-src-block))
": 2")))
(ert-deftest ob-eshell/variables-assignment ()
"Test ob-eshell variables assignment."
(should
(string=
(org-test-with-temp-text
"#+begin_src eshell :var hi=\"hello, world\"
echo $hi
#+end_src"
(org-babel-execute-src-block))
": hello, world")))
(ert-deftest ob-eshell/session ()
"Test ob-eshell session."
(should
(string=
(org-test-with-temp-text
"#+begin_src eshell :session
(setq hi \"hello, world\")
#+end_src
#+begin_src eshell :session
echo $hi
#+end_src"
(org-babel-execute-src-block)
(org-babel-next-src-block)
(org-babel-execute-src-block)
(goto-char (org-babel-where-is-src-block-result))
(forward-line)
(buffer-substring-no-properties (point) (line-end-position)))
": hello, world")))
(provide 'test-ob-eshell)
;;; test-ob-eshell.el ends here

591
lisp/org/testing/lisp/test-ob-exp.el Normal file
View File

@@ -0,0 +1,591 @@
;;; test-ob-exp.el
;; Copyright (c) 2010-2015, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;; Template test file for Org tests
;;; Code:
(defmacro org-test-with-expanded-babel-code (&rest body)
"Execute BODY while in a buffer with all Babel code evaluated.
Current buffer is a copy of the original buffer."
`(let ((string (org-with-wide-buffer (buffer-string)))
(narrowing (list (point-min) (point-max)))
(org-export-use-babel t))
(with-temp-buffer
(org-mode)
(insert string)
(apply #'narrow-to-region narrowing)
(org-babel-exp-process-buffer)
(goto-char (point-min))
(progn ,@body))))
(ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers ()
"Testing export without any headlines in the Org mode file."
(require 'ox-ascii)
(let ((text-file (concat (file-name-sans-extension org-test-no-heading-file)
".txt")))
(when (file-exists-p text-file) (delete-file text-file))
(org-test-in-example-file org-test-no-heading-file
;; Export the file to HTML.
(org-export-to-file 'ascii text-file))
;; should create a ".txt" file
(should (file-exists-p text-file))
;; should not create a file with "::" appended to its name
(should-not (file-exists-p (concat org-test-no-heading-file "::")))
(when (file-exists-p text-file) (delete-file text-file))))
(ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-file ()
"Testing export from buffers which are not visiting any file."
(require 'ox-ascii)
(let ((name (generate-new-buffer-name "*Org ASCII Export*")))
(org-test-in-example-file nil
(org-export-to-buffer 'ascii name nil nil nil t))
;; Should create a new buffer.
(should (buffer-live-p (get-buffer name)))
;; Should contain the content of the buffer.
(with-current-buffer (get-buffer name)
(should (string-match (regexp-quote org-test-file-ob-anchor)
(buffer-string))))
(when (get-buffer name) (kill-buffer name))))
(ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers2 ()
"Testing export without any headlines in the Org file."
(let ((html-file (concat (file-name-sans-extension
org-test-link-in-heading-file)
".html")))
(when (file-exists-p html-file) (delete-file html-file))
(org-test-in-example-file org-test-link-in-heading-file
;; export the file to html
(org-export-to-file 'html html-file))
;; should create a .html file
(should (file-exists-p html-file))
;; should not create a file with "::" appended to its name
(should-not (file-exists-p (concat org-test-link-in-heading-file "::")))
(when (file-exists-p html-file) (delete-file html-file))))
(ert-deftest ob-exp/noweb-on-export ()
"Noweb header arguments export correctly.
- yes expand on both export and tangle
- no expand on neither export or tangle
- tangle expand on only tangle not export"
(should
(equal
'("(message \"expanded1\")" "(message \"expanded2\")" ";; noweb-1-yes-start
(message \"expanded1\")" ";; noweb-no-start
<<noweb-example1>>" ";; noweb-2-yes-start
(message \"expanded2\")"
";; noweb-tangle-start
<<noweb-example1>>
<<noweb-example2>>")
(org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
(org-narrow-to-subtree)
(org-element-map
(org-test-with-expanded-babel-code (org-element-parse-buffer))
'src-block
(lambda (src) (org-trim (org-element-property :value src))))))))
(ert-deftest ob-exp/noweb-on-export-with-exports-results ()
"Noweb header arguments export correctly using :exports results.
- yes expand on both export and tangle
- no expand on neither export or tangle
- tangle expand on only tangle not export"
(should
(equal
'(";; noweb-no-start
<<noweb-example1>>" "<<noweb-example1>>
<<noweb-example2>>")
(org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d"
(org-narrow-to-subtree)
(org-element-map
(org-test-with-expanded-babel-code (org-element-parse-buffer))
'src-block
(lambda (src) (org-trim (org-element-property :value src))))))))
(ert-deftest ob-exp/exports-both ()
"Test the \":exports both\" header argument.
The code block evaluation should create both a code block and
a table."
(org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
(org-narrow-to-subtree)
(let ((tree (org-test-with-expanded-babel-code (org-element-parse-buffer))))
(should (and (org-element-map tree 'src-block 'identity)
(org-element-map tree 'table 'identity))))))
(ert-deftest ob-exp/mixed-blocks-with-exports-both ()
(should
(equal
'(property-drawer plain-list src-block fixed-width src-block plain-list)
(org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
(org-narrow-to-subtree)
(mapcar 'org-element-type
(org-element-map
(org-test-with-expanded-babel-code
(org-element-parse-buffer 'greater-element))
'section 'org-element-contents nil t))))))
(ert-deftest ob-exp/export-with-name ()
(should
(string-match
"=qux="
(let ((org-babel-exp-code-template
"=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
(org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
(org-narrow-to-subtree)
(org-test-with-expanded-babel-code
(buffer-string)))))))
(ert-deftest ob-exp/export-with-header-argument ()
(let ((org-babel-exp-code-template
"
| header | value |
|---------+----------|
| foo | %foo |
| results | %results |
#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
(org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
(org-narrow-to-subtree)
(org-test-with-expanded-babel-code
(should (string-match "baz" (buffer-string)))
(should (string-match "replace" (buffer-string)))))))
(ert-deftest ob-exp/noweb-no-export-and-exports-both ()
(should
(string-match
"<<noweb-no-export-and-exports-both-1>>"
(org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9"
(org-narrow-to-subtree)
(org-test-with-expanded-babel-code
(org-element-map (org-element-parse-buffer) 'src-block
(lambda (src-block) (org-element-property :value src-block))
nil t))))))
(ert-deftest ob-exp/evaluate-all-executables-in-order ()
(should
(equal '(5 4 3 2 1)
(let ((org-export-use-babel t) *evaluation-collector*)
(org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317"
(org-narrow-to-subtree)
(buffer-string)
(org-test-with-expanded-babel-code *evaluation-collector*))))))
(ert-deftest ob-exp/exports-inline ()
(should
(string-match
(regexp-quote "Here is one in the middle {{{results(=1=)}}} of a line.
Here is one at the end of a line. {{{results(=2=)}}}
{{{results(=3=)}}} Here is one at the beginning of a line.")
(org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
(org-narrow-to-subtree)
(let ((org-babel-inline-result-wrap "=%s="))
(org-test-with-expanded-babel-code (buffer-string)))))))
(ert-deftest ob-exp/exports-inline-code ()
(should
(equal "src_emacs-lisp[]{(+ 1 1)}"
(org-test-with-temp-text "src_emacs-lisp[:exports code]{(+ 1 1)}"
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(equal "src_emacs-lisp[]{(+ 1 1)}"
(org-test-with-temp-text "src_emacs-lisp[ :exports code ]{(+ 1 1)}"
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(equal "src_emacs-lisp[]{(+ 1 1)} {{{results(=2=)}}}"
(org-test-with-temp-text "src_emacs-lisp[:exports both]{(+ 1 1)}"
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(equal "{{{results(=2=)}}}"
(org-test-with-temp-text
"src_emacs-lisp[:exports results :results scalar]{(+ 1 1)}"
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(equal "foosrc_emacs-lisp[:exports code]{(+ 1 1)}"
(org-test-with-temp-text
"foosrc_emacs-lisp[:exports code]{(+ 1 1)}"
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(let ((text "src_emacs lisp{(+ 1 1)}"))
(string-match (regexp-quote text)
(org-test-with-temp-text
text
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string)))))
(should
(string-match
(replace-regexp-in-string
"\\\\\\[]{" "\\(?:\\[]\\)?{" ;accept both src_sh[]{...} or src_sh{...}
(regexp-quote "Here is one in the middle src_sh[]{echo 1} of a line.
Here is one at the end of a line. src_sh[]{echo 2}
src_sh[]{echo 3} Here is one at the beginning of a line.
Here is one that is also evaluated: src_sh[]{echo 4} {{{results(=4=)}}}")
nil t)
(org-test-at-id "cd54fc88-1b6b-45b6-8511-4d8fa7fc8076"
(org-narrow-to-subtree)
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-test-with-expanded-babel-code (buffer-string)))))))
(ert-deftest ob-exp/exports-inline-code-double-eval ()
"Based on default header arguments for inline code blocks (:exports
results), the resulting code block `src_emacs-lisp{2}' should also be
evaluated."
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(should
(string-match "\\`{{{results(src_emacs-lisp\\[\\]{2})}}}$"
(org-test-with-temp-text
"src_emacs-lisp[:exports results :results code]{(+ 1 1)}"
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-exp/exports-inline-code-eval-code-once ()
"Ibid above, except that the resulting inline code block should not
be evaluated."
(let ((org-export-use-babel t))
(should
(string-match "{{{results(src_emacs-lisp\\(?:\\[[: a-zA-Z]+]\\)?{2})}}}$"
(org-test-with-temp-text
(concat "src_emacs-lisp[:exports results :results code "
":results_switches \":exports code\"]{(+ 1 1)}")
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-exp/exports-inline-code-double-eval-exports-both ()
(let ((org-export-use-babel t))
(should
(string-match (concat "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)} "
"{{{results(src_emacs-lisp\\[ :exports code\\]{2})}}}$")
(org-test-with-temp-text
(concat "src_emacs-lisp[:exports both :results code "
":results_switches \":exports code\"]{(+ 1 1)}")
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-exp/export-call-line-information ()
(org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c"
(org-narrow-to-subtree)
(let ((org-babel-exp-call-line-template "\n: call: %line special-token"))
(org-test-with-expanded-babel-code
(should (string-match "double" (buffer-string)))
(should (string-match "16" (buffer-string)))
(should (string-match "special-token" (buffer-string)))))))
(ert-deftest ob-exp/noweb-strip-export-ensure-strips ()
(org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775"
(org-narrow-to-subtree)
(org-babel-next-src-block 2)
(should (= 110 (org-babel-execute-src-block)))
(let ((result (org-test-with-expanded-babel-code (buffer-string))))
(should-not (string-match (regexp-quote "<<strip-export-1>>") result))
(should-not (string-match (regexp-quote "i=\"10\"") result)))))
(ert-deftest ob-exp/use-case-of-reading-entry-properties ()
(org-test-at-id "cc5fbc20-bca5-437a-a7b8-2b4d7a03f820"
(org-narrow-to-subtree)
(let* ((case-fold-search nil)
(result (org-test-with-expanded-babel-code (buffer-string)))
(sect "a:1, b:0, c:3, d:0, e:0")
(sub0 "a:1, b:2, c:4, d:0, e:0")
(sub1 "a:1, b:2, c:5, d:0, e:6")
(func sub0))
;; entry "section"
(should (string-match (concat "_shell-sect-call\n: shell " sect "\n")
result))
(should (string-match (concat "_elisp-sect-call\n: elisp " sect "\n")
result))
(should (string-match (concat "\n- sect inline shell " sect "\n")
result))
(should (string-match (concat "\n- sect inline elisp " sect "\n")
result))
;; entry "subsection", call without arguments
(should (string-match (concat "_shell-sub0-call\n: shell " sub0 "\n")
result))
(should (string-match (concat "_elisp-sub0-call\n: elisp " sub0 "\n")
result))
(should (string-match (concat "\n- sub0 inline shell " sub0 "\n")
result))
(should (string-match (concat "\n- sub0 inline elisp " sub0 "\n")
result))
;; entry "subsection", call with arguments
(should (string-match (concat "_shell-sub1-call\n: shell " sub1 "\n")
result))
(should (string-match (concat "_elisp-sub1-call\n: elisp " sub1 "\n")
result))
(should (string-match (concat "\n- sub1 inline shell " sub1 "\n")
result))
(should (string-match (concat "\n- sub1 inline elisp " sub1 "\n")
result))
;; entry "function definition"
(should (string-match (concat "_location_shell\n: shell " func "\n")
result))
(should (string-match (concat "_location_elisp\n: elisp " func "\n")
result)))))
(ert-deftest ob-exp/export-from-a-temp-buffer ()
(let ((org-export-use-babel t))
(org-test-with-temp-text
"
#+Title: exporting from a temporary buffer
#+name: foo
#+BEGIN_SRC emacs-lisp
:foo
#+END_SRC
#+name: bar
#+BEGIN_SRC emacs-lisp
:bar
#+END_SRC
#+BEGIN_SRC emacs-lisp :var foo=foo :noweb yes :exports results
(list foo <<bar>>)
#+END_SRC
"
(let* ((ascii (org-export-as 'ascii)))
(should (string-match
(regexp-quote " :foo :bar \n")
ascii))))))
(ert-deftest ob-export/export-with-results-before-block ()
"Test export when results are inserted before source block."
(let ((org-export-use-babel t))
(should
(equal
"#+RESULTS: src1
: 2
#+NAME: src1
#+BEGIN_SRC emacs-lisp
\(+ 1 1)
#+END_SRC"
(org-test-with-temp-text
"#+RESULTS: src1
#+NAME: src1
#+BEGIN_SRC emacs-lisp :exports both
\(+ 1 1)
#+END_SRC"
(org-babel-exp-process-buffer)
(org-trim (org-no-properties (buffer-string))))))))
(ert-deftest ob-export/export-src-block-with-switches ()
"Test exporting a source block with switches."
(should
(string-match
"\\`#\\+BEGIN_SRC emacs-lisp -n -r$"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -n -r\n\(+ 1 1)\n#+END_SRC"
(org-babel-exp-process-buffer)
(buffer-string)))))
(ert-deftest ob-export/export-src-block-with-flags ()
"Test exporting a source block with a flag."
(should
(string-match
"\\`#\\+BEGIN_SRC emacs-lisp -some-flag$"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :flags -some-flag\n\(+ 1 1)\n#+END_SRC"
(org-babel-exp-process-buffer)
(buffer-string)))))
(ert-deftest ob-export/export-and-indentation ()
"Test indentation of evaluated source blocks during export."
;; No indentation.
(should
(string-match
"^t"
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
(let ((indent-tabs-mode t)
(tab-width 1)
(org-src-preserve-indentation nil))
(org-babel-exp-process-buffer)
(buffer-string)))))
;; Preserve indentation with "-i" flag.
(should
(string-match
"^ t"
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -i\n t\n#+END_SRC"
(let ((indent-tabs-mode t)
(tab-width 1))
(org-babel-exp-process-buffer)
(buffer-string)))))
;; Preserve indentation with a non-nil
;; `org-src-preserve-indentation'.
(should
(string-match
"^ t"
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
(let ((indent-tabs-mode t)
(tab-width 1)
(org-src-preserve-indentation t))
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-export/export-under-commented-headline ()
"Test evaluation of code blocks under COMMENT headings."
(let ((org-export-use-babel t)
(org-babel-inline-result-wrap "=%s="))
;; Do not eval block in a commented headline.
(should
(string-match
": 2"
(org-test-with-temp-text "* Headline
#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 1)
#+END_SRC"
(org-babel-exp-process-buffer)
(buffer-string))))
(should-not
(string-match
": 2"
(org-test-with-temp-text "* COMMENT Headline
#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 1)
#+END_SRC"
(org-babel-exp-process-buffer)
(buffer-string))))
;; Do not eval inline blocks either.
(should
(string-match
"=2="
(org-test-with-temp-text "* Headline
src_emacs-lisp{(+ 1 1)}"
(org-babel-exp-process-buffer)
(buffer-string))))
(should-not
(string-match
"=2="
(org-test-with-temp-text "* COMMENT Headline
src_emacs-lisp{(+ 1 1)}"
(org-babel-exp-process-buffer)
(buffer-string))))
;; Also check parent headlines.
(should-not
(string-match
": 2"
(org-test-with-temp-text "
* COMMENT Headline
** Children
#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 1)
#+END_SRC"
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-export/reference-in-post-header ()
"Test references in :post header during export."
(should
(org-test-with-temp-text "
#+NAME: foo
#+BEGIN_SRC emacs-lisp :exports none :var bar=\"baz\"
(concat \"bar\" bar)
#+END_SRC
#+NAME: nofun
#+BEGIN_SRC emacs-lisp :exports results :post foo(\"nofun\")
#+END_SRC"
(org-babel-exp-process-buffer) t)))
(ert-deftest ob-export/babel-evaluate ()
"Test `org-export-use-babel' effect."
;; When nil, no Babel code is executed.
(should-not
(string-match-p
"2"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
(let ((org-export-use-babel nil)) (org-babel-exp-process-buffer))
(buffer-string))))
(should-not
(string-match-p
"2"
(org-test-with-temp-text
"src_emacs-lisp{(+ 1 1)}"
(let ((org-export-use-babel nil)) (org-babel-exp-process-buffer))
(buffer-string))))
;; When non-nil, all Babel code types are executed.
(should
(string-match-p
"2"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
(let ((org-export-use-babel t)) (org-babel-exp-process-buffer))
(buffer-string))))
(should
(string-match-p
"2"
(org-test-with-temp-text
"src_emacs-lisp{(+ 1 1)}"
(let ((org-export-use-babel t)) (org-babel-exp-process-buffer))
(buffer-string)))))
(ert-deftest ob-export/body-with-coderef ()
"Test exporting a code block with coderefs."
(should
(equal "#+BEGIN_SRC emacs-lisp\n0 (ref:foo)\n#+END_SRC"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports code\n0 (ref:foo)\n#+END_SRC"
(let ((org-export-use-babel t)
(org-coderef-label-format "(ref:foo)"))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(equal
"#+BEGIN_SRC emacs-lisp -l \"r:%s\"\n1 r:foo\n#+END_SRC"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"r:%s\" -lisp :exports code\n1 r:foo\n#+END_SRC"
(let ((org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string)))))
(ert-deftest ob-exp/src-block-with-affiliated-keyword ()
"Test exporting a code block with affiliated keywords."
;; Pathological case: affiliated keyword matches inline source block
;; syntax.
(should
(equal "#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
(org-test-with-temp-text
"#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
(let ((org-export-use-babel t))
(org-babel-exp-process-buffer))
(buffer-string)))))
(provide 'test-ob-exp)
;;; test-ob-exp.el ends here

113
lisp/org/testing/lisp/test-ob-fortran.el Normal file
View File

@@ -0,0 +1,113 @@
;;; test-ob-fortran.el --- tests for ob-fortran.el
;; Copyright (c) 2010-2014, 2019 Sergey Litvinov
;; Authors: Sergey Litvinov
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "gfortran")
(unless (featurep 'ob-fortran)
(signal 'missing-test-dependency "Support for Fortran code blocks"))
(ert-deftest ob-fortran/assert ()
(should t))
(ert-deftest ob-fortran/simple-program ()
"Test of hello world program."
(org-test-at-id "459384e8-1797-4f11-867e-dde0473ea7cc"
(org-babel-next-src-block)
(should (equal "Hello world" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/fortran-var-program ()
"Test a fortran variable"
(org-test-at-id "459384e8-1797-4f11-867e-dde0473ea7cc"
(org-babel-next-src-block 2)
(should (= 10 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/input-var ()
"Test :var"
(org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242"
(org-babel-next-src-block)
(should (= 15 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/preprocessor-var ()
"Test preprocessed fortran"
(org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242"
(org-babel-next-src-block 2)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/character-var ()
"Test string input"
(org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242"
(org-babel-next-src-block 3)
(should (equal "word" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/list-var ()
"Test real array input"
(org-test-at-id "c28569d9-04ce-4cad-ab81-1ea29f691465"
(org-babel-next-src-block)
(should (equal "1.00 2.00 3.00" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/list-var-from-table ()
"Test real array from a table"
(org-test-at-id "c28569d9-04ce-4cad-ab81-1ea29f691465"
(org-babel-next-src-block 2)
(should (equal "1.00 2.00" (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/list-matrix-from-table1 ()
"Test real matrix from a table"
(org-test-at-id "3f73ab19-d25a-428d-8c26-e8c6aa933976"
(org-babel-next-src-block 1)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/list-matrix-from-table2 ()
"Test real matrix from a table"
(org-test-at-id "3f73ab19-d25a-428d-8c26-e8c6aa933976"
(org-babel-next-src-block 2)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-fortran/no-variables-with-main ()
"Test :var with explicit 'program'"
(org-test-at-id "891ead4a-f87a-473c-9ae0-1cf348bcd04f"
(org-babel-next-src-block)
(should-error (org-babel-execute-src-block))
:type 'error))
;; (ert-deftest ob-fortran/wrong-list ()
;; "Test wrong input list"
;; (org-test-at-id "891ead4a-f87a-473c-9ae0-1cf348bcd04f"
;; (org-babel-next-src-block 2)
;; (should-error (org-babel-execute-src-block))
;; :type 'error))
;; (ert-deftest ob-fortran/compiler-flags ()
;; "Test compiler's flags"
;; (org-test-at-id "891ead4a-f87a-473c-9ae0-1cf348bcd04f"
;; (org-babel-next-src-block 3)
;; (should-error (org-babel-execute-src-block))
;; :type 'error))
(ert-deftest ob-fortran/command-arguments ()
"Test real array from a table"
(org-test-at-id "2d5330ea-9934-4737-9ed6-e1d3dae2dfa4"
(org-babel-next-src-block)
(should (= 23 (org-babel-execute-src-block)))))
(provide 'test-ob-fortran)
;;; test-ob-fortran.el ends here

83
lisp/org/testing/lisp/test-ob-header-arg-defaults.el Normal file
View File

@@ -0,0 +1,83 @@
;;; test-ob-header-arg-defaults.el --- tests for default header args from properties
;; Copyright (c) 2013, 2014, 2019 Achim Gratz
;; Authors: Achim Gratz
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-ob-header-arg-defaults/global/call ()
(org-test-at-id "3fdadb69-5d15-411e-aad0-f7860cdd7816"
(org-babel-next-src-block 1)
(forward-line -1)
(should (equal "ge1/gh2/--3/ge4/ge5/--6/--7/--8/--9"
(org-babel-execute-src-block nil (org-babel-lob-get-info))))))
(ert-deftest test-ob-header-arg-defaults/global/noweb ()
(org-test-at-id "3fdadb69-5d15-411e-aad0-f7860cdd7816"
(org-babel-next-src-block 1)
(should (equal "ge1/gh2/--3/ge4/ge5/--6/--7"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-header-arg-defaults/tree/overwrite/call ()
(should
(equal "ge1/gh2/--3/ge4/ge5/--6/th7/te8/--9"
(org-test-at-id "a9cdfeda-9f31-4bb5-b694-2cf452f07dfd"
(org-babel-next-src-block 1)
(forward-line -1)
(org-babel-execute-src-block nil (org-babel-lob-get-info))))))
(ert-deftest test-ob-header-arg-defaults/tree/overwrite/noweb ()
(should
(equal "--1/--2/--3/--4/--5/--6/th7/te8/--9"
(org-test-at-id "a9cdfeda-9f31-4bb5-b694-2cf452f07dfd"
(org-babel-next-src-block 1)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-header-arg-defaults/tree/accumulate/call ()
(should
(equal "ge1/th2/th3/ge4/te5/--6"
(org-test-at-id "1d97d258-fd50-4107-a095-e4625bffc57b"
(org-babel-next-src-block 1)
(forward-line -1)
(org-babel-execute-src-block nil (org-babel-lob-get-info))))))
(ert-deftest test-ob-header-arg-defaults/tree/accumulate/noweb ()
(should
(equal "ge1/th2/th3/ge4/te5/--6/--7/--8"
(org-test-at-id "1d97d258-fd50-4107-a095-e4625bffc57b"
(org-babel-next-src-block 1)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-header-arg-defaults/tree/complex/call ()
(should
(equal "gh1/th2/--3/gh4/te5/--6"
(org-test-at-id "fa0e912d-d9b4-47b0-9f9e-1cbb39f7cbc2"
(org-babel-next-src-block 1)
(forward-line -1)
(org-babel-execute-src-block nil (org-babel-lob-get-info))))))
(ert-deftest test-ob-header-arg-defaults/tree/complex/noweb ()
(should
(equal "gh1/th2/--3/gh4/te5/--6/--7/--8/--9"
(org-test-at-id "fa0e912d-d9b4-47b0-9f9e-1cbb39f7cbc2"
(org-babel-next-src-block 1)
(org-babel-execute-src-block)))))
(provide 'test-ob-header-arg-defaults)
;;; test-ob-header-arg-defaults.el ends here

391
lisp/org/testing/lisp/test-ob-lilypond.el Normal file
View File

@@ -0,0 +1,391 @@
;;; test-ob-lilypond.el --- tests for ob-lilypond.el
;; Copyright (c) 2010-2014, 2019 Martyn Jago
;; Authors: Martyn Jago
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(unless (featurep 'ob-lilypond)
(signal 'missing-test-dependency "Support for Lilypond code blocks"))
(save-excursion
(set-buffer (get-buffer-create "test-ob-lilypond.el"))
(setq org-babel-lilypond-here
(file-name-directory
(or load-file-name (buffer-file-name)))))
(ert-deftest ob-lilypond/assert ()
(should t))
(ert-deftest ob-lilypond/feature-provision ()
(should (featurep 'ob-lilypond)))
(ert-deftest ob-lilypond/check-lilypond-alias ()
(should (fboundp 'lilypond-mode)))
(ert-deftest ob-lilypond/org-babel-tangle-lang-exts ()
(let ((found nil)
(list org-babel-tangle-lang-exts))
(while list
(when (equal (car list) '("LilyPond" . "ly"))
(setq found t))
(setq list (cdr list)))
(should found)))
(ert-deftest ob-lilypond/org-babel-prep-session:lilypond ()
(should-error (org-babel-prep-session:lilypond nil nil))
:type 'error)
(ert-deftest ob-lilypond/ly-compile-lilyfile ()
(should (equal
`(,org-babel-lilypond-ly-command ;program
nil ;infile
"*lilypond*" ;buffer
t ;display
,(if org-babel-lilypond-gen-png "--png" "") ;&rest...
,(if org-babel-lilypond-gen-html "--html" "")
,(if org-babel-lilypond-gen-pdf "--pdf" "")
,(if org-babel-lilypond-use-eps "-dbackend=eps" "")
,(if org-babel-lilypond-gen-svg "-dbackend=svg" "")
"--output=test-file"
"test-file.ly")
(org-babel-lilypond-compile-lilyfile "test-file.ly" t))))
(ert-deftest ob-lilypond/ly-compile-post-tangle ()
(should (boundp 'org-babel-lilypond-compile-post-tangle)))
(ert-deftest ob-lilypond/ly-display-pdf-post-tangle ()
(should (boundp 'org-babel-lilypond-display-pdf-post-tangle)))
(ert-deftest ob-lilypond/ly-play-midi-post-tangle ()
(should (boundp 'org-babel-lilypond-play-midi-post-tangle)))
(ert-deftest ob-lilypond/ly-command-ly/bound ()
(should (boundp 'org-babel-lilypond-ly-command)))
(ert-deftest ob-lilypond/ly-command-ly/stringp ()
(should (stringp org-babel-lilypond-ly-command)))
(ert-deftest ob-lilypond/ly-command-pdf/bound ()
(should (boundp 'org-babel-lilypond-pdf-command)))
(ert-deftest ob-lilypond/ly-command-pdf/stringp ()
(should (stringp org-babel-lilypond-pdf-command)))
(ert-deftest ob-lilypond/ly-command-midi/bound ()
(should (boundp 'org-babel-lilypond-midi-command)))
(ert-deftest ob-lilypond/ly-command-midi/stringp ()
(should (stringp org-babel-lilypond-midi-command)))
(ert-deftest ob-lilypond/ly-commands/darwin ()
(let ((system-type 'darwin)
org-babel-lilypond-ly-command
org-babel-lilypond-pdf-command
org-babel-lilypond-midi-command)
(custom-reevaluate-setting 'org-babel-lilypond-commands)
(should (equal
(list
org-babel-lilypond-ly-command
org-babel-lilypond-pdf-command
org-babel-lilypond-midi-command)
(list
"/Applications/lilypond.app/Contents/Resources/bin/lilypond"
"open"
"open"))))
(custom-reevaluate-setting 'org-babel-lilypond-commands))
(ert-deftest ob-lilypond/ly-commands/windows-nt ()
(let ((system-type 'windows-nt)
org-babel-lilypond-ly-command
org-babel-lilypond-pdf-command
org-babel-lilypond-midi-command)
(custom-reevaluate-setting 'org-babel-lilypond-commands)
(should (equal
(list
org-babel-lilypond-ly-command
org-babel-lilypond-pdf-command
org-babel-lilypond-midi-command)
(list
"lilypond"
""
""))))
(custom-reevaluate-setting 'org-babel-lilypond-commands))
(ert-deftest ob-lilypond/ly-commands/other ()
(let ((system-type 'other)
org-babel-lilypond-ly-command
org-babel-lilypond-pdf-command
org-babel-lilypond-midi-command)
(custom-reevaluate-setting 'org-babel-lilypond-commands)
(should (equal
(list
org-babel-lilypond-ly-command
org-babel-lilypond-pdf-command
org-babel-lilypond-midi-command)
(list
"lilypond"
"xdg-open"
"xdg-open"))))
(custom-reevaluate-setting 'org-babel-lilypond-commands))
(ert-deftest ob-lilypond/ly-gen-png ()
(should (boundp 'org-babel-lilypond-gen-png)))
(ert-deftest ob-lilypond/ly-gen-svg ()
(should (boundp 'org-babel-lilypond-gen-svg)))
(ert-deftest ob-lilypond/ly-gen-html ()
(should (boundp 'org-babel-lilypond-gen-html)))
(ert-deftest ob-lilypond/ly-gen-pdf ()
(should (boundp 'org-babel-lilypond-gen-pdf)))
(ert-deftest ob-lilypond/use-eps ()
(should (boundp 'org-babel-lilypond-use-eps)))
(ert-deftest ob-lilypond/ly-arrange-mode ()
(should (boundp 'org-babel-lilypond-arrange-mode)))
;; (ert-deftest ob-lilypond/org-babel-default-header-args:lilypond ()
;; (should (equal '((:tangle . "yes")
;; (:noweb . "yes")
;; (:results . "silent")
;; (:comments . "yes"))
;; org-babel-default-header-args:lilypond)))
;;TODO finish...
(ert-deftest ob-lilypond/org-babel-expand-body:lilypond ()
(should (equal "This is a test"
(org-babel-expand-body:lilypond "This is a test" ()))))
;;TODO (ert-deftest org-babel-lilypond-test-org-babel-execute:lilypond ())
(ert-deftest ob-lilypond/ly-check-for-compile-error ()
(set-buffer (get-buffer-create "*lilypond*"))
(erase-buffer)
(should (not (org-babel-lilypond-check-for-compile-error nil t)))
(insert-file-contents (concat org-babel-lilypond-here
"../examples/ob-lilypond-test.error")
nil nil nil t)
(goto-char (point-min))
(should (org-babel-lilypond-check-for-compile-error nil t))
(kill-buffer "*lilypond*"))
(ert-deftest ob-lilypond/ly-process-compile-error ()
(find-file-other-window (concat
org-babel-lilypond-here
"../examples/ob-lilypond-broken.org"))
(set-buffer (get-buffer-create "*lilypond*"))
(insert-file-contents (concat
org-babel-lilypond-here
"../examples/ob-lilypond-test.error")
nil nil nil t)
(goto-char (point-min))
(search-forward "error:" nil t)
(should-error
(org-babel-lilypond-process-compile-error (concat
org-babel-lilypond-here
"../examples/ob-lilypond-broken.ly"))
:type 'error)
(set-buffer "ob-lilypond-broken.org")
(should (equal 238 (point)))
(exchange-point-and-mark)
(should (equal (+ 238 (length "line 25")) (point)))
(kill-buffer "*lilypond*")
(kill-buffer "ob-lilypond-broken.org"))
(ert-deftest ob-lilypond/ly-mark-error-line ()
(let ((file-name (concat
org-babel-lilypond-here
"../examples/ob-lilypond-broken.org"))
(expected-point-min 198)
(expected-point-max 205)
(line "line 20"))
(find-file-other-window file-name)
(org-babel-lilypond-mark-error-line file-name line)
(should (equal expected-point-min (point)))
(exchange-point-and-mark)
(should (= expected-point-max (point)))
(kill-buffer (file-name-nondirectory file-name))))
(ert-deftest ob-lilypond/ly-parse-line-num ()
(with-temp-buffer
(insert-file-contents (concat
org-babel-lilypond-here
"../examples/ob-lilypond-test.error")
nil nil nil t)
(goto-char (point-min))
(search-forward "error:")
(should (equal 25 (org-babel-lilypond-parse-line-num (current-buffer))))))
(ert-deftest ob-lilypond/ly-parse-error-line ()
(let ((org-babel-lilypond-file (concat
org-babel-lilypond-here
"../examples/ob-lilypond-broken.ly")))
(should (equal "line 20"
(org-babel-lilypond-parse-error-line org-babel-lilypond-file 20)))
(should (not (org-babel-lilypond-parse-error-line org-babel-lilypond-file 0)))))
(ert-deftest ob-lilypond/ly-attempt-to-open-pdf ()
(let ((post-tangle org-babel-lilypond-display-pdf-post-tangle)
(org-babel-lilypond-file (concat
org-babel-lilypond-here
"../examples/ob-lilypond-test.ly"))
(pdf-file (concat
org-babel-lilypond-here
"../examples/ob-lilypond-test.pdf")))
(setq org-babel-lilypond-display-pdf-post-tangle t)
(when (not (file-exists-p pdf-file))
(set-buffer (get-buffer-create (file-name-nondirectory pdf-file)))
(write-file pdf-file))
(should (equal
(concat
org-babel-lilypond-pdf-command " " pdf-file)
(org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-file t)))
(delete-file pdf-file)
(kill-buffer (file-name-nondirectory pdf-file))
(should (string-prefix-p "No pdf file generated"
(org-babel-lilypond-attempt-to-open-pdf pdf-file)))
(setq org-babel-lilypond-display-pdf-post-tangle post-tangle)))
(ert-deftest ob-lilypond/ly-attempt-to-play-midi ()
(let ((post-tangle org-babel-lilypond-play-midi-post-tangle)
(org-babel-lilypond-file (concat
org-babel-lilypond-here
"../examples/ob-lilypond-test.ly"))
(midi-file (concat
org-babel-lilypond-here
"../examples/ob-lilypond-test.midi")))
(setq org-babel-lilypond-play-midi-post-tangle t)
(when (not (file-exists-p midi-file))
(set-buffer (get-buffer-create (file-name-nondirectory midi-file)))
(write-file midi-file))
(should (equal
(concat
org-babel-lilypond-midi-command " " midi-file)
(org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-file t)))
(delete-file midi-file)
(kill-buffer (file-name-nondirectory midi-file))
(should (string-prefix-p
"No midi file generated"
(org-babel-lilypond-attempt-to-play-midi midi-file)))
(setq org-babel-lilypond-play-midi-post-tangle post-tangle)))
(ert-deftest ob-lilypond/ly-toggle-midi-play-toggles-flag ()
(if org-babel-lilypond-play-midi-post-tangle
(progn
(org-babel-lilypond-toggle-midi-play)
(should (not org-babel-lilypond-play-midi-post-tangle))
(org-babel-lilypond-toggle-midi-play)
(should org-babel-lilypond-play-midi-post-tangle))
(org-babel-lilypond-toggle-midi-play)
(should org-babel-lilypond-play-midi-post-tangle)
(org-babel-lilypond-toggle-midi-play)
(should (not org-babel-lilypond-play-midi-post-tangle))))
(ert-deftest ob-lilypond/ly-toggle-pdf-display-toggles-flag ()
(if org-babel-lilypond-display-pdf-post-tangle
(progn
(org-babel-lilypond-toggle-pdf-display)
(should (not org-babel-lilypond-display-pdf-post-tangle))
(org-babel-lilypond-toggle-pdf-display)
(should org-babel-lilypond-display-pdf-post-tangle))
(org-babel-lilypond-toggle-pdf-display)
(should org-babel-lilypond-display-pdf-post-tangle)
(org-babel-lilypond-toggle-pdf-display)
(should (not org-babel-lilypond-display-pdf-post-tangle))))
(ert-deftest ob-lilypond/ly-toggle-pdf-generation-toggles-flag ()
(if org-babel-lilypond-gen-pdf
(progn
(org-babel-lilypond-toggle-pdf-generation)
(should (not org-babel-lilypond-gen-pdf))
(org-babel-lilypond-toggle-pdf-generation)
(should org-babel-lilypond-gen-pdf))
(org-babel-lilypond-toggle-pdf-generation)
(should org-babel-lilypond-gen-pdf)
(org-babel-lilypond-toggle-pdf-generation)
(should (not org-babel-lilypond-gen-pdf))))
(ert-deftest ob-lilypond/ly-toggle-arrange-mode ()
(if org-babel-lilypond-arrange-mode
(progn
(org-babel-lilypond-toggle-arrange-mode)
(should (not org-babel-lilypond-arrange-mode))
(org-babel-lilypond-toggle-arrange-mode)
(should org-babel-lilypond-arrange-mode))
(org-babel-lilypond-toggle-arrange-mode)
(should org-babel-lilypond-arrange-mode)
(org-babel-lilypond-toggle-arrange-mode)
(should (not org-babel-lilypond-arrange-mode))))
(ert-deftest ob-lilypond/ly-toggle-png-generation-toggles-flag ()
(if org-babel-lilypond-gen-png
(progn
(org-babel-lilypond-toggle-png-generation)
(should (not org-babel-lilypond-gen-png))
(org-babel-lilypond-toggle-png-generation)
(should org-babel-lilypond-gen-png))
(org-babel-lilypond-toggle-png-generation)
(should org-babel-lilypond-gen-png)
(org-babel-lilypond-toggle-png-generation)
(should (not org-babel-lilypond-gen-png))))
(ert-deftest ob-lilypond/ly-toggle-html-generation-toggles-flag ()
(if org-babel-lilypond-gen-html
(progn
(org-babel-lilypond-toggle-html-generation)
(should (not org-babel-lilypond-gen-html))
(org-babel-lilypond-toggle-html-generation)
(should org-babel-lilypond-gen-html))
(org-babel-lilypond-toggle-html-generation)
(should org-babel-lilypond-gen-html)
(org-babel-lilypond-toggle-html-generation)
(should (not org-babel-lilypond-gen-html))))
(ert-deftest ob-lilypond/ly-switch-extension-with-extensions ()
(should (equal "test-name.xyz"
(org-babel-lilypond-switch-extension "test-name" ".xyz")))
(should (equal "test-name.xyz"
(org-babel-lilypond-switch-extension "test-name.abc" ".xyz")))
(should (equal "test-name"
(org-babel-lilypond-switch-extension "test-name.abc" ""))))
(ert-deftest ob-lilypond/ly-switch-extension-with-paths ()
(should (equal "/some/path/to/test-name.xyz"
(org-babel-lilypond-switch-extension "/some/path/to/test-name" ".xyz"))))
(ert-deftest ob-lilypond/ly-get-header-args ()
(should (equal '((:tangle . "yes")
(:noweb . "yes")
(:results . "silent")
(:cache . "yes")
(:comments . "yes"))
(org-babel-lilypond-set-header-args t)))
(should (equal '((:results . "file")
(:exports . "results"))
(org-babel-lilypond-set-header-args nil))))
(ert-deftest ob-lilypond/ly-set-header-args ()
(org-babel-lilypond-set-header-args t)
(should (equal '((:tangle . "yes")
(:noweb . "yes")
(:results . "silent")
(:cache . "yes")
(:comments . "yes"))
org-babel-default-header-args:lilypond))
(org-babel-lilypond-set-header-args nil)
(should (equal '((:results . "file")
(:exports . "results"))
org-babel-default-header-args:lilypond)))
(provide 'test-ob-lilypond)
;;; test-ob-lilypond.el ends here

255
lisp/org/testing/lisp/test-ob-lob.el Normal file
View File

@@ -0,0 +1,255 @@
;;; test-ob-lob.el --- test for ob-lob.el
;; Copyright (c) 2010-2015, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
(eval-and-compile (require 'cl-lib))
;;; Tests
(org-babel-lob-ingest
(expand-file-name
"library-of-babel.org"
(expand-file-name
"doc"
(expand-file-name
".."
(expand-file-name
".."
(file-name-directory
(or load-file-name buffer-file-name)))))))
(ert-deftest test-ob-lob/ingest ()
"Test the ingestion of an Org file."
(should (< 0 (org-babel-lob-ingest
(expand-file-name "babel.org" org-test-example-dir)))))
(ert-deftest test-ob-lob/call-with-header-arguments ()
"Test the evaluation of a library of babel #+call: line."
(cl-letf (((symbol-function 'org-babel-insert-result)
(symbol-function 'ignore)))
(let ((org-babel-library-of-babel
(org-test-with-temp-text-in-file
"
#+name: echo
#+begin_src emacs-lisp :var input=\"echo'd\"
input
#+end_src
#+name: lob-minus
#+begin_src emacs-lisp :var a=0 :var b=0
(- a b)
#+end_src"
(org-babel-lob-ingest)
org-babel-library-of-babel)))
(org-test-at-id "fab7e291-fde6-45fc-bf6e-a485b8bca2f0"
(move-beginning-of-line 1)
(forward-line 6)
(message (buffer-substring (point-at-bol) (point-at-eol)))
(should
(string= "testing" (org-babel-execute-src-block
nil (org-babel-lob-get-info))))
(forward-line 1)
(should
(string= "testing" (caar (org-babel-execute-src-block
nil (org-babel-lob-get-info)))))
(forward-line 1)
(should
(string= "testing" (org-babel-execute-src-block
nil (org-babel-lob-get-info))))
(forward-line 1)
(should
(string= "testing" (caar (org-babel-execute-src-block
nil (org-babel-lob-get-info)))))
(forward-line 1)
(should
(string= "testing" (org-babel-execute-src-block
nil (org-babel-lob-get-info))))
(forward-line 1)
(should
(string= "testing" (caar (org-babel-execute-src-block
nil (org-babel-lob-get-info)))))
(forward-line 1) (beginning-of-line) (forward-char 27)
(should
(string= "testing" (org-babel-execute-src-block
nil (org-babel-lob-get-info))))
(forward-line 1) (beginning-of-line) (forward-char 27)
(should
(string= "testing" (caar (org-babel-execute-src-block
nil (org-babel-lob-get-info)))))
(forward-line 1) (beginning-of-line)
(should
(= 4 (org-babel-execute-src-block nil (org-babel-lob-get-info))))
(forward-line 1)
(should
(string= "testing" (org-babel-execute-src-block
nil (org-babel-lob-get-info))))
(forward-line 1)
(should (string= "123" (org-babel-execute-src-block
nil (org-babel-lob-get-info))))))))
(ert-deftest test-ob-lob/export-lob-lines ()
"Test the export of a variety of library babel call lines."
(let ((org-babel-inline-result-wrap "=%s=")
(org-export-use-babel t))
(org-test-at-id "72ddeed3-2d17-4c7f-8192-a575d535d3fc"
(org-narrow-to-subtree)
(let ((string (org-with-wide-buffer (buffer-string)))
(narrowing (list (point-min) (point-max))))
(with-temp-buffer
(org-mode)
(insert string)
(apply #'narrow-to-region narrowing)
(org-babel-exp-process-buffer)
(message (buffer-string))
(goto-char (point-min))
(should (re-search-forward "^: 0" nil t))
(should (re-search-forward "call {{{results(=2=)}}} stuck" nil t))
(should (re-search-forward
"exported =call_double(it=2)= because" nil t))
(should (re-search-forward "^{{{results(=6=)}}} because" nil t))
(should (re-search-forward "results 8 should" nil t))
(should (re-search-forward "following 2\\*5={{{results(=10=)}}} should" nil t)))))))
(ert-deftest test-ob-lob/do-not-eval-lob-lines-in-example-blocks-on-export ()
(require 'ox)
(org-test-with-temp-text-in-file "
for export
#+begin_example
#+call: rubbish()
#+end_example"
(should (progn (org-babel-exp-process-buffer) t))))
(ert-deftest test-ob-lob/caching-call-line ()
(let ((temporary-value-for-test 0))
(org-test-with-temp-text "
#+name: call-line-caching-example
#+begin_src emacs-lisp :var bar=\"baz\"
(setq temporary-value-for-test (+ 1 temporary-value-for-test))
#+end_src
<point>#+call: call-line-caching-example(\"qux\") :cache yes
"
;; first execution should flip value to t
(should
(eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1))
;; if cached, second evaluation will retain the t value
(should
(eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1)))))
(ert-deftest test-ob-lob/named-caching-call-line ()
(let ((temporary-value-for-test 0))
(org-test-with-temp-text "
#+name: call-line-caching-example
#+begin_src emacs-lisp :var bar=\"baz\"
(setq temporary-value-for-test (+ 1 temporary-value-for-test))
#+end_src
#+name: call-line-caching-called
<point>#+call: call-line-caching-example(\"qux\") :cache yes
"
;; first execution should flip value to t
(should
(eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1))
;; if cached, second evaluation will retain the t value
(should
(eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1)))))
(ert-deftest test-ob-lob/assignment-with-newline ()
"Test call lines with an argument containing a newline character."
(should
(equal " foo"
(org-test-with-temp-text "
#+name: test-newline
#+begin_src emacs-lisp :var x=\"a\"
'foo
#+end_src
call_test-newline[:eval yes :results raw](\"a\nb\")<point>"
(org-babel-execute-src-block nil (org-babel-lob-get-info))
(buffer-substring (point) (point-max)))))
(should
(equal " bar"
(org-test-with-temp-text "
#+name: test-newline
#+begin_src emacs-lisp :var x=\"a\"
'bar
#+end_src
call_test-newline[:eval yes :results raw]('(1\n2))<point>"
(org-babel-execute-src-block nil (org-babel-lob-get-info))
(buffer-substring (point) (point-max))))))
(ert-deftest test-ob-lob/external-reference-syntax ()
"Test external reference syntax for Babel calls."
(should
(= 2
(org-test-with-temp-text-in-file
"#+name: foo\n#+begin_src emacs-lisp\n(+ 1 1)\n#+end_src"
(let ((file (buffer-file-name)))
(org-test-with-temp-text (format "#+call: %s:foo()" file)
(org-babel-execute-src-block nil (org-babel-lob-get-info))))))))
(ert-deftest test-ob-lob/call-with-indirection ()
"Test calling code with indirection."
(should
(= 2
(org-test-with-temp-text
"
#+name: foo
#+begin_src emacs-lisp
\(+ 1 1)
#+end_src
#+name: bar
#+call: foo()
<point>#+call: bar()"
(org-babel-execute-src-block nil (org-babel-lob-get-info)))))
(should
(= 10
(org-test-with-temp-text
"
#+name: foo
#+begin_src emacs-lisp :var x=1
\(* 2 x)
#+end_src
#+name: bar
#+call: foo(x=3)
<point>#+call: bar(x=5)"
(org-babel-execute-src-block nil (org-babel-lob-get-info)))))
(should
(= 6
(org-test-with-temp-text
"
#+name: foo
#+begin_src emacs-lisp :var x=1
\(* 2 x)
#+end_src
#+name: bar
#+call: foo(x=3)
<point>#+call: bar()"
(org-babel-execute-src-block nil (org-babel-lob-get-info))))))
(provide 'test-ob-lob)
;;; test-ob-lob.el ends here

141
lisp/org/testing/lisp/test-ob-lua.el Normal file
View File

@@ -0,0 +1,141 @@
;;; test-ob-lua.el --- tests for ob-lua.el
;; Copyright (c) 2016, 2019 Thibault Marin
;; Authors: Thibault Marin
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(unless (featurep 'ob-lua)
(signal 'missing-test-dependency "Support for Lua code blocks"))
(ert-deftest test-ob-lua/simple-value ()
"Test associative array return by value."
(should
(= 2
(org-test-with-temp-text
"#+name: eg
| a | 1 |
| b | 2 |
#+header: :results value
#+header: :var x = eg
#+begin_src lua
return x['b']
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-lua/simple-output ()
"Test text output from table."
(should
(equal "result: c\n"
(org-test-with-temp-text
"#+name: eg
| a | b | c | d |
#+header: :results output
#+header: :var x = eg
#+begin_src lua
print('result: ' .. x[1][3])
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-lua/colnames-yes-header-argument ()
"Test table passing with `colnames' header."
(should
(equal "a"
(org-test-with-temp-text
"#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames yes
#+header: :var x = eg
#+begin_src lua
return x[1]
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-lua/colnames-yes-header-argument-pp ()
"Test table passing with `colnames' header and pp option."
(should
(equal "a = 12\nb = 13\n"
(org-test-with-temp-text
"#+name: eg
| col | val |
|-----+-----|
| a | 12 |
| b | 13 |
#+header: :results value pp
#+header: :colnames yes
#+header: :var x = eg
#+begin_src lua
return x
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-lua/colnames-nil-header-argument ()
"Test table with `colnames' set to `nil'."
(should
(equal "1 = a\n2 = b\n"
(org-test-with-temp-text
"#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames nil
#+header: :var x = eg
#+header: :results value pp
#+begin_src lua
return x
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest test-ob-lua/colnames-no-header-argument ()
"Test table passing without `colnames'."
(should
(equal "1 = col\n2 = a\n3 = b\n"
(org-test-with-temp-text
"#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames no
#+header: :var x = eg
#+header: :results value pp
#+begin_src lua
return x
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(provide 'test-ob-lua)
;;; test-ob-lua.el ends here

74
lisp/org/testing/lisp/test-ob-maxima.el Normal file
View File

@@ -0,0 +1,74 @@
;;; test-ob-maxima.el --- tests for ob-maxima.el
;; Copyright (c) 2010-2014, 2019 Sergey Litvinov
;; Authors: Sergey Litvinov
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
(org-test-for-executable "maxima")
(unless (featurep 'ob-maxima)
(signal 'missing-test-dependency "Support for Maxima code blocks"))
(ert-deftest ob-maxima/assert ()
(should t))
(ert-deftest ob-maxima/integer-input ()
"Test of integer input"
(org-test-at-id "b5842ed4-8e8b-4b18-a1c9-cef006b6a6c8"
(org-babel-next-src-block)
(should (equal 4 (org-babel-execute-src-block)))))
(ert-deftest ob-maxima/string-input ()
"Test of string input"
(org-test-at-id "b5842ed4-8e8b-4b18-a1c9-cef006b6a6c8"
(org-babel-next-src-block 2)
(should (equal "- sin(x)" (org-babel-execute-src-block)))))
(ert-deftest ob-maxima/simple-list-input ()
"Test of flat list input"
(org-test-at-id "b5561c6a-73cd-453a-ba5e-62ad84844de6"
(org-babel-next-src-block)
(should (equal "[1, 2, 3] " (org-babel-execute-src-block)))))
(ert-deftest ob-maxima/list-input ()
"Test of list input"
(org-test-at-id "b5561c6a-73cd-453a-ba5e-62ad84844de6"
(org-babel-next-src-block 2)
(should (equal "[2, [2, 3], 4] " (org-babel-execute-src-block)))))
(ert-deftest ob-maxima/table-input1 ()
"Test of table input"
(org-test-at-id "400ee228-6b12-44fd-8097-7986f0f0db43"
(org-babel-next-src-block)
(should (equal "[[2.0], [3.0]] " (org-babel-execute-src-block)))))
(ert-deftest ob-maxima/table-input2 ()
"Test of table input"
(org-test-at-id "400ee228-6b12-44fd-8097-7986f0f0db43"
(org-babel-next-src-block 2)
(should (equal "[[2.0, 3.0]] " (org-babel-execute-src-block)))))
(ert-deftest ob-maxima/matrix-output ()
"Test of table output"
(org-test-at-id "cc158527-b867-4b1d-8ae0-b8c713a90fd7"
(org-babel-next-src-block)
(should
(equal
'((1 2 3) (2 3 4) (3 4 5)) (org-babel-execute-src-block)))))
(provide 'test-ob-maxima)
;;; test-ob-maxima.el ends here

65
lisp/org/testing/lisp/test-ob-octave.el Normal file
View File

@@ -0,0 +1,65 @@
;;; test-ob-octave.el --- tests for ob-octave.el
;; Copyright (c) 2010-2014, 2019 Sergey Litvinov
;; Authors: Sergey Litvinov
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
(org-test-for-executable "octave")
(unless (featurep 'ob-octave)
(signal 'missing-test-dependency "Support for Octave code blocks"))
(ert-deftest ob-octave/input-none ()
"Number output"
(org-test-at-id "54dcd61d-cf6c-4d7a-b9e5-854953c8a753"
(org-babel-next-src-block)
(should (= 10 (org-babel-execute-src-block)))))
(ert-deftest ob-octave/output-vector ()
"Vector output"
(org-test-at-id "54dcd61d-cf6c-4d7a-b9e5-854953c8a753"
(org-babel-next-src-block 2)
(should (equal '((1 2 3 4)) (org-babel-execute-src-block)))))
(ert-deftest ob-octave/input-variable ()
"Input variable"
(org-test-at-id "cc2d82bb-2ac0-45be-a0c8-d1463b86a3ba"
(org-babel-next-src-block)
(should (= 42 (org-babel-execute-src-block)))))
(ert-deftest ob-octave/input-array ()
"Input an array"
(org-test-at-id "cc2d82bb-2ac0-45be-a0c8-d1463b86a3ba"
(org-babel-next-src-block 2)
(should (equal '((1 2 3)) (org-babel-execute-src-block)))))
(ert-deftest ob-octave/input-matrix ()
"Input a matrix"
(org-test-at-id "cc2d82bb-2ac0-45be-a0c8-d1463b86a3ba"
(org-babel-next-src-block 3)
(should (equal '((1 2) (3 4)) (org-babel-execute-src-block)))))
(ert-deftest ob-octave/input-string ()
"Input a string"
(org-test-at-id "cc2d82bb-2ac0-45be-a0c8-d1463b86a3ba"
(org-babel-next-src-block 4)
(should (equal "te" (org-babel-execute-src-block)))))
(ert-deftest ob-octave/input-nil ()
"Input elisp nil"
(org-test-at-id "cc2d82bb-2ac0-45be-a0c8-d1463b86a3ba"
(org-babel-next-src-block 5)
(should (equal nil (org-babel-execute-src-block)))))

78
lisp/org/testing/lisp/test-ob-perl.el Normal file
View File

@@ -0,0 +1,78 @@
;;; test-ob-perl.el --- tests for ob-perl.el
;; Copyright (c) 2013, 2014, 2019 Achim Gratz
;; Authors: Achim Gratz
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "perl")
(unless (featurep 'ob-perl)
(signal 'missing-test-dependency "Support for perl code blocks"))
(ert-deftest test-ob-perl/simple-output ()
(org-test-with-temp-text "
#+header: :results output
#+begin_src perl
print qq(Hi Mom!$/I'm home.);
#+end_src"
(org-babel-next-src-block)
(should (equal "Hi Mom!\nI'm home."
(org-babel-execute-src-block)))))
(ert-deftest test-ob-perl/simple-value ()
(org-test-with-temp-text "
#+header: :results value
#+begin_src perl
qq(Hi Mom!$/I'm home.);
#+end_src"
(org-babel-next-src-block)
(should (equal '(("Hi Mom!") ("I'm home."))
(org-babel-execute-src-block)))))
(ert-deftest test-ob-perl/table-passthrough-colnames-nil ()
(org-test-with-temp-text "#+name: eg
| col1 | col2 |
|------+------|
| a | 1 |
| b | 2.0 |
#+header: :colnames nil
#+header: :var x = eg
#+begin_src perl
#+end_src"
(org-babel-next-src-block)
(should (equal '(("col1" "col2") hline ("a" 1) ("b" 2.0))
(org-babel-execute-src-block)))))
(ert-deftest test-ob-perl/table-passthrough-colnames-no ()
(org-test-with-temp-text "#+name: eg
| col1 | col2 |
|------+------|
| a | 1 |
| b | 2.0 |
#+header: :colnames no
#+header: :var x = eg
#+begin_src perl
#+end_src"
(org-babel-next-src-block)
(should (equal '(("col1" "col2") ("a" 1) ("b" 2.0))
(org-babel-execute-src-block)))))
(provide 'test-ob-perl)
;;; test-ob-perl.el ends here

73
lisp/org/testing/lisp/test-ob-plantuml.el Normal file
View File

@@ -0,0 +1,73 @@
;;; test-ob-plantuml.el --- tests for ob-plantuml.el
;; Copyright (c) 2016, 2019 Thibault Marin
;; Authors: Thibault Marin
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(unless (featurep 'ob-plantuml)
(signal 'missing-test-dependency "Support for PlantUML code blocks"))
(ert-deftest test-ob-plantuml/single-var ()
"Test file output with input variable."
(should
(string=
"@startuml
!define CLASSNAME test_class
class CLASSNAME
@enduml"
(let ((org-plantuml-jar-path nil))
(org-test-with-temp-text
"#+name: variable_value
: test_class
#+header: :file tmp.puml
#+header: :var CLASSNAME=variable_value
#+begin_src plantuml
class CLASSNAME
#+end_src"
(org-babel-next-src-block)
(let ((src-block-info (cdr (org-babel-get-src-block-info))))
(org-babel-plantuml-make-body
(car src-block-info)
(car (cdr src-block-info)))))))))
(ert-deftest test-ob-plantuml/prologue ()
"Test file output with prologue."
(should
(string=
"@startuml
skinparam classBackgroundColor #FF0000
class test_class
@enduml"
(let ((org-plantuml-jar-path nil))
(org-test-with-temp-text
"#+header: :file tmp.puml
#+header: :prologue skinparam classBackgroundColor #FF0000
#+begin_src plantuml
class test_class
#+end_src"
(org-babel-next-src-block)
(let ((src-block-info (cdr (org-babel-get-src-block-info))))
(org-babel-plantuml-make-body
(car src-block-info)
(car (cdr src-block-info)))))))))
(provide 'test-ob-plantuml)
;;; test-ob-plantuml.el ends here

143
lisp/org/testing/lisp/test-ob-python.el Normal file
View File

@@ -0,0 +1,143 @@
;;; test-ob-python.el --- tests for ob-python.el
;; Copyright (c) 2011-2014, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "python")
(unless (featurep 'ob-python)
(signal 'missing-test-dependency "Support for Python code blocks"))
(ert-deftest test-ob-python/colnames-yes-header-argument ()
(should
(equal '(("col") hline ("a") ("b"))
(org-test-with-temp-text "#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames yes
#+header: :var x = eg
<point>#+begin_src python
return x
#+end_src"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-python/colnames-yes-header-argument-again ()
(should
(equal '(("a") hline ("b*") ("c*"))
(org-test-with-temp-text "#+name: less-cols
| a |
|---|
| b |
| c |
#+header: :colnames yes
<point>#+begin_src python :var tab=less-cols
return [[val + '*' for val in row] for row in tab]
#+end_src"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-python/colnames-nil-header-argument ()
(should
(equal '(("col") hline ("a") ("b"))
(org-test-with-temp-text "#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames nil
#+header: :var x = eg
<point>#+begin_src python
return x
#+end_src"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-python/colnames-no-header-argument-again ()
(should
(equal '(("a*") ("b*") ("c*"))
(org-test-with-temp-text "#+name: less-cols
| a |
|---|
| b |
| c |
#+header: :colnames no
<point>#+begin_src python :var tab=less-cols
return [[val + '*' for val in row] for row in tab]
#+end_src"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-python/colnames-no-header-argument ()
(should
(equal '(("col") ("a") ("b"))
(org-test-with-temp-text "#+name: eg
| col |
|-----|
| a |
| b |
#+header: :colnames no
#+header: :var x = eg
<point>#+begin_src python
return x
#+end_src"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-python/session-multiline ()
;; FIXME workaround to prevent starting prompt leaking into output
(run-python)
(sleep-for 0 10)
(should
(equal "20"
(org-test-with-temp-text "#+begin_src python :session :results output
foo = 0
for _ in range(10):
foo += 1
foo += 1
print(foo)
#+end_src"
(org-babel-execute-src-block)))))
(ert-deftest test-ob-python/insert-necessary-blank-line-when-sending-code-to-interpreter ()
(should
(equal 2 (org-test-with-temp-text "#+begin_src python :session :results value
if True:
1
2
#+end_src"
;; Previously, while adding `:session' to a normal code
;; block, also need to add extra blank lines to end
;; indent block or indicate logical sections. Now, the
;; `org-babel-python-evaluate-session' can do it
;; automatically:
;;
;; >>> if True:
;; >>> 1
;; >>> <insert_blank_line_here>
;; >>> 2
(org-babel-execute-maybe)
(org-babel-execute-src-block)))))
(provide 'test-ob-python)
;;; test-ob-python.el ends here

81
lisp/org/testing/lisp/test-ob-ruby.el Normal file
View File

@@ -0,0 +1,81 @@
;;; test-ob-ruby.el --- tests for ob-ruby.el
;; Copyright (c) 2013-2015, 2019 Oleh Krehel
;; Authors: Oleh Krehel
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "ruby")
(unless (featurep 'ob-ruby)
(signal 'missing-test-dependency "Support for Ruby code blocks"))
(ert-deftest test-ob-ruby/session-output-1 ()
(should (equal (org-test-with-temp-text "#+begin_src ruby :session org-test-ruby :results output
s = \"1\"
s = \"2\"
s = \"3\"
puts s
s = \"4\"
#+end_src"
(org-babel-execute-maybe)
(substring-no-properties
(buffer-string)))
"#+begin_src ruby :session org-test-ruby :results output
s = \"1\"
s = \"2\"
s = \"3\"
puts s
s = \"4\"
#+end_src
#+RESULTS:
: 3
")))
(ert-deftest test-ob-ruby/session-output-2 ()
(should (equal (org-test-with-temp-text "#+begin_src ruby :session org-test-ruby :results output
puts s
s = \"5\"
#+end_src"
(org-babel-execute-maybe)
(substring-no-properties
(buffer-string)))
"#+begin_src ruby :session org-test-ruby :results output
puts s
s = \"5\"
#+end_src
#+RESULTS:
: 4
")))
(ert-deftest test-ob-ruby/session-output-3 ()
(should (equal (org-test-with-temp-text "#+begin_src ruby :session org-test-ruby :results output
puts s
s = \"6\"
#+end_src"
(org-babel-execute-maybe)
(substring-no-properties
(buffer-string)))
"#+begin_src ruby :session org-test-ruby :results output
puts s
s = \"6\"
#+end_src
#+RESULTS:
: 5
")))
(provide 'test-ob-ruby)
;;; test-ob-ruby.el ends here

111
lisp/org/testing/lisp/test-ob-scheme.el Normal file
View File

@@ -0,0 +1,111 @@
;;; test-ob-scheme.el --- Tests for Babel scheme -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit tests for Org Babel Scheme.
;;; Code:
(unless (featurep 'ob-scheme)
(signal 'missing-test-dependency "Support for Scheme code blocks"))
(ert-deftest test-ob-scheme/tables ()
"Test table output."
(equal "#+begin_src scheme
'(1 2 3)
#+end_src
#+RESULTS:
| 1 | 2 | 3 |
"
(org-test-with-temp-text "#+begin_src scheme\n'(1 2 3)\n#+end_src"
(org-babel-execute-maybe)
(buffer-string))))
(ert-deftest test-ob-scheme/verbatim ()
"Test verbatim output."
(should
(equal ": (1 2 3)\n"
(org-test-with-temp-text "#+begin_src scheme :results verbatim\n'(1 2 3)\n#+end_src"
(org-babel-execute-src-block)
(let ((case-fold-search t)) (search-forward "#+results"))
(buffer-substring-no-properties (line-beginning-position 2)
(point-max))))))
(ert-deftest test-ob-scheme/list ()
"Test list output."
(should
(equal "- 1\n- 2\n- 3\n"
(org-test-with-temp-text "#+begin_src scheme :results list\n'(1 2 3)\n#+end_src"
(org-babel-execute-maybe)
(let ((case-fold-search t)) (search-forward "#+results"))
(buffer-substring-no-properties (line-beginning-position 2)
(point-max))))))
(ert-deftest test-ob-scheme/prologue ()
"Test :prologue parameter."
(should
(equal "#+begin_src scheme :prologue \"(define x 2)\"
x
#+end_src
#+RESULTS:
: 2
"
(org-test-with-temp-text
"#+begin_src scheme :prologue \"(define x 2)\"\nx\n#+end_src"
(org-babel-execute-maybe)
(buffer-string))))
(should
(equal
"#+begin_src scheme :prologue \"(define x 2)\" :var y=1
x
#+end_src
#+RESULTS:
: 2
"
(org-test-with-temp-text
"#+begin_src scheme :prologue \"(define x 2)\" :var y=1\nx\n#+end_src"
(org-babel-execute-maybe)
(buffer-string)))))
(ert-deftest test-ob-scheme/unspecified ()
"Test <#unspecified> return value."
(should
(equal "#+begin_src scheme
\(define (mysquare x)
(* x x))
#+end_src
#+RESULTS:
: #<unspecified>
"
(org-test-with-temp-text
"#+begin_src scheme
(define (mysquare x)
(* x x))
#+end_src"
(org-babel-execute-maybe)
(buffer-string)))))
(provide 'test-ob-scheme)
;;; test-ob-scheme.el ends here

62
lisp/org/testing/lisp/test-ob-sed.el Normal file
View File

@@ -0,0 +1,62 @@
;;; test-ob-sed.el --- tests for ob-sed.el
;; Copyright (c) 2015, 2019 Bjarte Johansen
;; Authors: Bjarte Johansen
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'ob-sed)
(org-test-for-executable "sed")
(unless (featurep 'ob-sed)
(signal 'missing-test-dependency "Support for Sed code blocks"))
(ert-deftest ob-sed-test/simple-execution-of-script ()
"Test simple execution of script."
(org-test-at-id "C7E7CA6A-2601-42C9-B534-4102D62E458D"
(org-babel-next-src-block)
(should (string= "A processed sentence."
(org-babel-execute-src-block)))))
(ert-deftest ob-sed-test/in-file-header-argument ()
"Test :in-file header argument."
(org-test-at-id "54EC49AA-FE9F-4D58-812E-00FC87FAF562"
(let ((default-directory temporary-file-directory))
(with-temp-buffer
(insert "A test file.")
(write-file "test1.txt"))
(org-babel-next-src-block)
(should (string= "A tested file."
(org-babel-execute-src-block))))))
(ert-deftest ob-sed-test/cmd-line-header-argument ()
"Test :cmd-line header argument."
(org-test-at-id "E3C6A8BA-39FF-4840-BA8E-90D5C4365AB1"
(let ((default-directory temporary-file-directory))
(with-temp-buffer
(insert "A test file.")
(write-file "test2.txt"))
(org-babel-next-src-block)
(org-babel-execute-src-block)
(should (string= "A tested again file.\n"
(with-temp-buffer
(insert-file-contents "test2.txt")
(buffer-string)))))))
;;; test-ob-sed ends here

107
lisp/org/testing/lisp/test-ob-shell.el Normal file
View File

@@ -0,0 +1,107 @@
;;; test-ob-shell.el
;; Copyright (c) 2010-2014, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comment:
;; Template test file for Org tests
;;; Code:
(org-test-for-executable "sh")
(unless (featurep 'ob-shell)
(signal 'missing-test-dependency "Support for Shell code blocks"))
(ert-deftest test-ob-shell/dont-insert-spaces-on-expanded-bodies ()
"Expanded shell bodies should not start with a blank line
unless the body of the tangled block does."
(should-not (string-match "^[\n\r][\t ]*[\n\r]"
(org-babel-expand-body:generic "echo 2" '())))
(should (string-match "^[\n\r][\t ]*[\n\r]"
(org-babel-expand-body:generic "\n\necho 2" '()))))
(ert-deftest test-ob-shell/dont-error-on-empty-results ()
"Was throwing an elisp error when shell blocks threw errors and
returned empty results."
(should (null (org-babel-execute:sh "ls NoSuchFileOrDirectory.txt" nil))))
(ert-deftest test-ob-shell/session ()
"This also tests `org-babel-comint-with-output' in
ob-comint.el, which was not previously tested."
(let ((res (org-babel-execute:sh "echo 1; echo 2" '((:session . "yes")))))
(should res)
(should (listp res))))
; A list of tests using the samples in ob-shell-test.org
(ert-deftest ob-shell/generic-uses-no-arrays ()
"No arrays for generic"
(org-test-at-id "0ba56632-8dc1-405c-a083-c204bae477cf"
(org-babel-next-src-block)
(should (equal "one two three" (org-babel-execute-src-block)))))
(ert-deftest ob-shell/bash-uses-arrays ()
"Bash arrays"
(org-test-at-id "0ba56632-8dc1-405c-a083-c204bae477cf"
(org-babel-next-src-block 2)
(should (equal "one" (org-babel-execute-src-block)))))
(ert-deftest ob-shell/generic-uses-no-assoc-arrays ()
"No associative arrays for generic"
(should
(equal "first one second two third three"
(org-test-at-id "bec1a5b0-4619-4450-a8c0-2a746b44bf8d"
(org-babel-next-src-block)
(org-babel-execute-src-block))))
(should
(equal "bread 2 kg spaghetti 20 cm milk 50 dl"
(org-test-at-id "82320a48-3409-49d7-85c9-5de1c6d3ff87"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest ob-shell/bash-uses-assoc-arrays ()
"Bash associative arrays"
(should
(equal "two"
(org-test-at-id "bec1a5b0-4619-4450-a8c0-2a746b44bf8d"
(org-babel-next-src-block 2)
(org-babel-execute-src-block))))
;; Bash associative arrays as strings for the row.
(should
(equal "20 cm"
(org-test-at-id "82320a48-3409-49d7-85c9-5de1c6d3ff87"
(org-babel-next-src-block 2)
(org-babel-execute-src-block)))))
(ert-deftest ob-shell/simple-list ()
"Test list variables in shell."
;; With bash, a list is turned into an array.
(should
(= 2
(org-test-with-temp-text
"#+BEGIN_SRC bash :var l='(1 2)\necho ${l[1]}\n#+END_SRC"
(org-babel-execute-src-block))))
;; On sh, it is a string containing all values.
(should
(equal "1 2"
(org-test-with-temp-text
"#+BEGIN_SRC sh :var l='(1 2)\necho ${l}\n#+END_SRC"
(org-babel-execute-src-block)))))
(provide 'test-ob-shell)
;;; test-ob-shell.el ends here

46
lisp/org/testing/lisp/test-ob-sqlite.el Normal file
View File

@@ -0,0 +1,46 @@
;;; test-ob-sqlite.el --- tests for ob-sqlite.el
;; Copyright (C) 2017, 2019 Eduardo Bellani
;; Author: Eduardo Bellani <ebellani@gmail.com>
;; Keywords: lisp
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "sqlite3")
(require 'ob-sqlite)
(unless (featurep 'ob-sqlite)
(signal 'missing-test-dependency "Support for sqlite code blocks"))
(ert-deftest ob-sqlite/table-variables-with-commas ()
"Test of a table variable that contains commas. This guarantees that this code path results in a valid CSV."
(should
(equal '(("Mr Test A. Sql"
"Minister for Science, Eternal Happiness, and Finance"))
(org-test-with-temp-text
"#+name: test_table1
| \"Mr Test A. Sql\" | Minister for Science, Eternal Happiness, and Finance |
#+begin_src sqlite :db /tmp/test.db :var tb=test_table1
drop table if exists TestTable;
create table TestTable(person, job);
.mode csv TestTable
.import $tb TestTable
select * from TestTable;
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
;;; test-ob-sqlite.el ends here

35
lisp/org/testing/lisp/test-ob-table.el Normal file
View File

@@ -0,0 +1,35 @@
;;; test-ob-table.el
;; Copyright (c) 2011-2014, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;; Template test file for Org tests
;;; Code:
;; TODO Test Broken (wrong-type-argument number-or-marker-p "2.0")
;; (ert-deftest test-ob-table/sbe ()
;; "Test that `sbe' can be used to call code blocks from inside tables."
;; (org-test-at-id "6d2ff4ce-4489-4e2a-9c65-e3f71f77d975"
;; (should (= 2 (sbe take-sqrt (n "4"))))))
(provide 'test-ob-table)
;;; test-ob-table.el ends here

385
lisp/org/testing/lisp/test-ob-tangle.el Normal file
View File

@@ -0,0 +1,385 @@
;;; test-ob-tangle.el --- tests for ob-tangle.el
;; Copyright (c) 2010-2016, 2019 Eric Schulte
;; Authors: Eric Schulte
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;; Template test file for Org tests
;;; Code:
;; TODO
;; (ert-deftest ob-tangle/noweb-on-tangle ()
;; "Noweb header arguments tangle correctly.
;; - yes expand on both export and tangle
;; - no expand on neither export or tangle
;; - tangle expand on only tangle not export"
;; (let ((target-file (make-temp-file "ob-tangle-test-")))
;; (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
;; (org-narrow-to-subtree)
;; (org-babel-tangle target-file))
;; (let ((tang (with-temp-buffer
;; (insert-file-contents target-file)
;; (buffer-string))))
;; (flet ((exp-p (arg)
;; (and
;; (string-match
;; (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
;; tang)
;; (string-match "expanded" (match-string 1 tang)))))
;; (should (exp-p "yes"))
;; (should-not (exp-p "no"))
;; (should (exp-p "tangle"))))))
(ert-deftest ob-tangle/no-excessive-id-insertion-on-tangle ()
"Don't add IDs to headings without tangling code blocks."
(org-test-at-id "ef06fd7f-012b-4fde-87a2-2ae91504ea7e"
(org-babel-next-src-block)
(org-narrow-to-subtree)
(org-babel-tangle)
(should (null (org-id-get)))))
(ert-deftest ob-tangle/continued-code-blocks-w-noweb-ref ()
"Test that the :noweb-ref header argument is used correctly."
(org-test-at-id "54d68d4b-1544-4745-85ab-4f03b3cbd8a0"
(let ((tangled
"df|sed '1d'|awk '{print $5 \" \" $6}'|sort -n |tail -1|awk '{print $2}'"))
(org-narrow-to-subtree)
(org-babel-tangle)
(should (unwind-protect
(with-temp-buffer
(insert-file-contents "babel.sh")
(goto-char (point-min))
(re-search-forward (regexp-quote tangled) nil t))
(when (file-exists-p "babel.sh") (delete-file "babel.sh")))))))
(ert-deftest ob-tangle/expand-headers-as-noweb-references ()
"Test that references to headers are expanded during noweb expansion."
(org-test-at-id "2409e8ba-7b5f-4678-8888-e48aa02d8cb4"
(org-babel-next-src-block 2)
(let ((expanded (org-babel-expand-noweb-references)))
(should (string-match (regexp-quote "simple") expanded))
(should (string-match (regexp-quote "length 14") expanded)))))
(ert-deftest ob-tangle/comment-links-at-left-margin ()
"Test commenting of links at left margin."
(should
(string-match
(regexp-quote "# [[https://orgmode.org][Org mode]]")
(org-test-with-temp-text-in-file
"[[https://orgmode.org][Org mode]]
#+header: :comments org :tangle \"test-ob-tangle.sh\"
#+begin_src sh
echo 1
#+end_src"
(unwind-protect
(progn (org-babel-tangle)
(with-temp-buffer (insert-file-contents "test-ob-tangle.sh")
(buffer-string)))
(delete-file "test-ob-tangle.sh"))))))
(ert-deftest ob-tangle/comment-links-numbering ()
"Test numbering of source blocks when commenting with links."
(should
(org-test-with-temp-text-in-file
"* H
#+header: :tangle \"test-ob-tangle.el\" :comments link
#+begin_src emacs-lisp
1
#+end_src
#+header: :tangle \"test-ob-tangle.el\" :comments link
#+begin_src emacs-lisp
2
#+end_src"
(unwind-protect
(progn
(org-babel-tangle)
(with-temp-buffer
(insert-file-contents "test-ob-tangle.el")
(buffer-string)
(goto-char (point-min))
(and (search-forward "[H:1]]" nil t)
(search-forward "[H:2]]" nil t))))
(delete-file "test-ob-tangle.el")))))
(ert-deftest ob-tangle/jump-to-org ()
"Test `org-babel-tangle-jump-to-org' specifications."
;; Standard test.
(should
(equal
"* H\n#+begin_src emacs-lisp\n1\n#+end_src"
(org-test-with-temp-text-in-file
"* H\n#+begin_src emacs-lisp\n1\n#+end_src"
(let ((file (buffer-file-name)))
(org-test-with-temp-text
(format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
(file-name-nondirectory file))
(org-babel-tangle-jump-to-org)
(buffer-string))))))
;; Multiple blocks in the same section.
(should
(equal
"2"
(org-test-with-temp-text-in-file
"* H
first block
#+begin_src emacs-lisp
1
#+end_src
another block
#+begin_src emacs-lisp
2
#+end_src
"
(let ((file (buffer-file-name)))
(org-test-with-temp-text
(format ";; [[file:%s][H:2]]\n<point>2\n;; H:2 ends here\n"
(file-name-nondirectory file))
(org-babel-tangle-jump-to-org)
(buffer-substring (line-beginning-position)
(line-end-position)))))))
;; Preserve position within the source code.
(should
(equal
"1)"
(org-test-with-temp-text-in-file
"* H\n#+begin_src emacs-lisp\n(+ 1 1)\n#+end_src"
(let ((file (buffer-file-name)))
(org-test-with-temp-text
(format ";; [[file:%s][H:1]]\n(+ 1 <point>1)\n;; H:1 ends here\n"
(file-name-nondirectory file))
(org-babel-tangle-jump-to-org)
(buffer-substring-no-properties (point) (line-end-position)))))))
;; Blocks before first heading.
(should
(equal
"Buffer start\n#+begin_src emacs-lisp\n1\n#+end_src\n* H"
(org-test-with-temp-text-in-file
"Buffer start\n#+begin_src emacs-lisp\n1\n#+end_src\n* H"
(let ((file (buffer-file-name)))
(org-test-with-temp-text
(format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
(file-name-nondirectory file))
(org-babel-tangle-jump-to-org)
(buffer-string))))))
;; Special case: buffer starts with a source block.
(should
(equal
"#+begin_src emacs-lisp\n1\n#+end_src\n* H"
(org-test-with-temp-text-in-file
"#+begin_src emacs-lisp\n1\n#+end_src\n* H"
(let ((file (buffer-file-name)))
(org-test-with-temp-text
(format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
(file-name-nondirectory file))
(org-babel-tangle-jump-to-org)
(buffer-string)))))))
(ert-deftest ob-tangle/nested-block ()
"Test tangling of org file with nested block."
(should
(string=
"#+begin_src org
,#+begin_src emacs-lisp
1
,#+end_src
#+end_src
"
(org-test-with-temp-text-in-file
"#+header: :tangle \"test-ob-tangle.org\"
#+begin_src org
,#+begin_src org
,,#+begin_src emacs-lisp
1
,,#+end_src
,#+end_src
#+end_src"
(unwind-protect
(progn (org-babel-tangle)
(with-temp-buffer (insert-file-contents "test-ob-tangle.org")
(buffer-string)))
(delete-file "test-ob-tangle.org"))))))
(ert-deftest ob-tangle/block-order ()
"Test order of tangled blocks."
;; Order per language.
(should
(equal '("1" "2")
(let ((file (make-temp-file "org-tangle-")))
(unwind-protect
(progn
(org-test-with-temp-text-in-file
(format "#+property: header-args :tangle %S
#+begin_src emacs-lisp
1
#+end_src
#+begin_src emacs-lisp
2
#+end_src"
file)
(org-babel-tangle))
(with-temp-buffer
(insert-file-contents file)
(org-split-string (buffer-string))))
(delete-file file)))))
;; Order per source block.
(should
(equal '("1" "2")
(let ((file (make-temp-file "org-tangle-")))
(unwind-protect
(progn
(org-test-with-temp-text-in-file
(format "#+property: header-args :tangle %S
#+begin_src foo
1
#+end_src
#+begin_src bar
2
#+end_src"
file)
(org-babel-tangle))
(with-temp-buffer
(insert-file-contents file)
(org-split-string (buffer-string))))
(delete-file file)))))
;; Preserve order with mixed languages.
(should
(equal '("1" "3" "2" "4")
(let ((file (make-temp-file "org-tangle-")))
(unwind-protect
(progn
(org-test-with-temp-text-in-file
(format "#+property: header-args :tangle %S
#+begin_src foo
1
#+end_src
#+begin_src bar
2
#+end_src
#+begin_src foo
3
#+end_src
#+begin_src bar
4
#+end_src"
file)
(org-babel-tangle))
(with-temp-buffer
(insert-file-contents file)
(org-split-string (buffer-string))))
(delete-file file))))))
(ert-deftest ob-tangle/commented-src-blocks ()
"Test omission of commented src blocks."
(should
(equal '("A")
(let ((file (make-temp-file "org-tangle-")))
(unwind-protect
(progn
(org-test-with-temp-text-in-file
(format "#+property: header-args :tangle %S
* A
#+begin_src emacs-lisp
A
#+end_src
* COMMENT B
#+begin_src emacs-lisp
B
#+end_src
* C
# #+begin_src emacs-lisp
# C
# #+end_src
* D
#+begin_comment
#+begin_src emacs-lisp
D
#+end_src
#+end_comment"
file)
(org-babel-tangle))
(with-temp-buffer
(insert-file-contents file)
(org-split-string (buffer-string))))
(delete-file file)))))
(should
(equal '("A")
(let ((file (make-temp-file "org-tangle-")))
(unwind-protect
(progn
(org-test-with-temp-text-in-file
(format "#+property: header-args :tangle %S
* A
#+begin_src elisp :noweb yes
A
<<B>>
<<C>>
<<D>>
#+end_src
* COMMENT B
#+begin_src elisp :noweb-ref B
B
#+end_src
* C
# #+begin_src elisp :noweb-ref C
# C
# #+end_src
* D
#+begin_comment
#+begin_src elisp :noweb-ref D
D
#+end_src
#+end_comment"
file)
(let (org-babel-noweb-error-all-langs
org-babel-noweb-error-langs)
(org-babel-tangle)))
(with-temp-buffer
(insert-file-contents file)
(org-split-string (buffer-string))))
(delete-file file))))))
(provide 'test-ob-tangle)
;;; test-ob-tangle.el ends here

104
lisp/org/testing/lisp/test-ob-vala.el Normal file
View File

@@ -0,0 +1,104 @@
;;; test-ob-vala.el --- tests for ob-vala.el
;; Copyright (C) 2017, 2019 Christian Garbs
;; Authors: Christian Garbs
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(unless (featurep 'ob-vala)
(signal 'missing-test-dependency "Support for Vala code blocks"))
(org-test-for-executable org-babel-vala-compiler)
(ert-deftest ob-vala/assert ()
(should t))
(ert-deftest ob-vala/static-output ()
"Parse static output to variable."
(should (= 42
(org-test-with-temp-text
"
#+begin_src vala
class Demo.HelloWorld : GLib.Object {
public static int main(string[] args) {
stdout.printf(\"42\n\");
return 0;
}
}
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest ob-vala/return-numerics ()
"Return multiple numeric values."
(should (equal '((0) (1) (2))
(org-test-with-temp-text
"
#+begin_src vala
class Demo.HelloWorld : GLib.Object {
public static int main(string[] args) {
for (int i=0; i<3; i++) {
stdout.printf(\"%d\n\", i);
}
return 0;
}
}
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest ob-vala/compiler-args ()
"Pass compiler arguments."
(should (string= "Foo"
(org-test-with-temp-text
"
#+begin_src vala :flags -D FOO
class Demo.HelloWorld : GLib.Object {
public static int main(string[] args) {
#if FOO
stdout.printf(\"Foo\n\");
#else
stdout.printf(\"No foo\n\");
#endif
return 0;
}
}
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
(ert-deftest ob-vala/comdline-args ()
"Pass commandline arguments."
(should (equal '(("foo") ("bar"))
(org-test-with-temp-text
"
#+begin_src vala :cmdline foo bar
class Demo.HelloWorld : GLib.Object {
public static int main(string[] args) {
// skip args[0], it is the binary name
for (int i=1; i < args.length; i++) {
stdout.printf(\"%s\n\" , args[i]);
}
return 0;
}
}
#+end_src"
(org-babel-next-src-block)
(org-babel-execute-src-block)))))
;;; test-ob-vala.el ends here

2134
lisp/org/testing/lisp/test-ob.el Normal file
View File

File diff suppressed because it is too large Load Diff

36
lisp/org/testing/lisp/test-ol-bbdb.el Normal file
View File

@@ -0,0 +1,36 @@
;;; test-org-bbdb.el --- tests for org-bbdb.el -*- lexical-binding: t; -*-
;; Copyright (C) 2018, 2019 Marco Wahl
;; Author: <marcowahlsoft@gmail.com>
;; Keywords: calendar
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Test some of org-bbdb.el.
;;; Code:
(require 'ol-bbdb)
(ert-deftest test-org-bbdb-anniv-extract-date ()
(should (equal nil (org-bbdb-anniv-extract-date "foo")))
(should (equal '(9 22 2018) (org-bbdb-anniv-extract-date "2018-09-22")))
(should (equal '(9 22 nil) (org-bbdb-anniv-extract-date "09-22"))))
(provide 'test-ol-bbdb)
;;; test-org-bbdb.el ends here

381
lisp/org/testing/lisp/test-ol.el Normal file
View File

@@ -0,0 +1,381 @@
;;; test-ol.el --- Tests for Org Links library -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <https://www.gnu.org/licenses/>.
;;; Code:
;;; Decode and Encode Links
(ert-deftest test-ol/encode ()
"Test `org-link-encode' specifications."
;; Regural test.
(should (string= "Foo%3A%42ar" (org-link-encode "Foo:Bar" '(?\: ?\B))))
;; Encode an ASCII character.
(should (string= "%5B" (org-link-encode "[" '(?\[))))
;; Encode an ASCII control character.
(should (string= "%09" (org-link-encode "\t" '(9))))
;; Encode a Unicode multibyte character.
(should (string= "%E2%82%AC" (org-link-encode "€" '(?\€)))))
(ert-deftest test-ol/decode ()
"Test `org-link-decode' specifications."
;; Decode an ASCII character.
(should (string= "[" (org-link-decode "%5B")))
;; Decode an ASCII control character.
(should (string= "\n" (org-link-decode "%0A")))
;; Decode a Unicode multibyte character.
(should (string= "€" (org-link-decode "%E2%82%AC"))))
(ert-deftest test-ol/encode-url-with-escaped-char ()
"Encode and decode a URL that includes an encoded char."
(should
(string= "http://some.host.com/form?&id=blah%2Bblah25"
(org-link-decode
(org-link-encode "http://some.host.com/form?&id=blah%2Bblah25"
'(?\s ?\[ ?\] ?%))))))
;;; Escape and Unescape Links
(ert-deftest test-ol/escape ()
"Test `org-link-escape' specifications."
;; No-op when there is no backslash or square bracket.
(should (string= "foo" (org-link-escape "foo")))
;; Escape square brackets at boundaries of the link.
(should (string= "\\[foo\\]" (org-link-escape "[foo]")))
;; Escape square brackets followed by another square bracket.
(should (string= "foo\\]\\[bar" (org-link-escape "foo][bar")))
(should (string= "foo\\]\\]bar" (org-link-escape "foo]]bar")))
(should (string= "foo\\[\\[bar" (org-link-escape "foo[[bar")))
(should (string= "foo\\[\\]bar" (org-link-escape "foo[]bar")))
;; Escape backslashes at the end of the link.
(should (string= "foo\\\\" (org-link-escape "foo\\")))
;; Escape backslashes that could be confused with escaping
;; characters.
(should (string= "foo\\\\\\]" (org-link-escape "foo\\]")))
(should (string= "foo\\\\\\]\\[" (org-link-escape "foo\\][")))
(should (string= "foo\\\\\\]\\]bar" (org-link-escape "foo\\]]bar")))
;; Do not escape backslash characters when unnecessary.
(should (string= "foo\\bar" (org-link-escape "foo\\bar")))
;; Pathological cases: consecutive closing square brackets.
(should (string= "\\[\\[\\[foo\\]\\]\\]" (org-link-escape "[[[foo]]]")))
(should (string= "\\[\\[foo\\]\\] bar" (org-link-escape "[[foo]] bar"))))
(ert-deftest test-ol/unescape ()
"Test `org-link-unescape' specifications."
;; No-op if there is no backslash.
(should (string= "foo" (org-link-unescape "foo")))
;; No-op if backslashes are not escaping backslashes.
(should (string= "foo\\bar" (org-link-unescape "foo\\bar")))
;; Unescape backslashes before square brackets.
(should (string= "foo]bar" (org-link-unescape "foo\\]bar")))
(should (string= "foo\\]" (org-link-unescape "foo\\\\\\]")))
(should (string= "foo\\][" (org-link-unescape "foo\\\\\\][")))
(should (string= "foo\\]]bar" (org-link-unescape "foo\\\\\\]\\]bar")))
(should (string= "foo\\[[bar" (org-link-unescape "foo\\\\\\[\\[bar")))
(should (string= "foo\\[]bar" (org-link-unescape "foo\\\\\\[\\]bar")))
;; Unescape backslashes at the end of the link.
(should (string= "foo\\" (org-link-unescape "foo\\\\")))
;; Unescape closing square bracket at boundaries of the link.
(should (string= "[foo]" (org-link-unescape "\\[foo\\]")))
;; Pathological cases: consecutive closing square brackets.
(should (string= "[[[foo]]]" (org-link-unescape "\\[\\[\\[foo\\]\\]\\]")))
(should (string= "[[foo]] bar" (org-link-unescape "\\[\\[foo\\]\\] bar"))))
(ert-deftest test-ol/make-string ()
"Test `org-link-make-string' specifications."
;; Throw an error on empty URI.
(should-error (org-link-make-string ""))
;; Empty description returns a [[URI]] construct.
(should (string= "[[uri]]"(org-link-make-string "uri")))
;; Non-empty description returns a [[URI][DESCRIPTION]] construct.
(should
(string= "[[uri][description]]"
(org-link-make-string "uri" "description")))
;; Escape "]]" strings in the description with zero-width spaces.
(should
(let ((zws (string ?\x200B)))
(string= (format "[[uri][foo]%s]bar]]" zws)
(org-link-make-string "uri" "foo]]bar"))))
;; Prevent description from ending with a closing square bracket
;; with a zero-width space.
(should
(let ((zws (string ?\x200B)))
(string= (format "[[uri][foo]%s]]" zws)
(org-link-make-string "uri" "foo]")))))
;;; Store links
(ert-deftest test-ol/store-link ()
"Test `org-store-link' specifications."
;; On a headline, link to that headline. Use heading as the
;; description of the link.
(should
(let (org-store-link-props org-stored-links)
(org-test-with-temp-text-in-file "* H1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*H1][H1]]" file)
(org-store-link nil))))))
;; On a headline, remove any link from description.
(should
(let (org-store-link-props org-stored-links)
(org-test-with-temp-text-in-file "* [[#l][d]]"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*%s][d]]"
file
(org-link-escape "[[#l][d]]"))
(org-store-link nil))))))
(should
(let (org-store-link-props org-stored-links)
(org-test-with-temp-text-in-file "* [[l]]"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*%s][l]]" file (org-link-escape "[[l]]"))
(org-store-link nil))))))
(should
(let (org-store-link-props org-stored-links)
(org-test-with-temp-text-in-file "* [[l1][d1]] [[l2][d2]]"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*%s][d1 d2]]"
file
(org-link-escape "[[l1][d1]] [[l2][d2]]"))
(org-store-link nil))))))
;; On a named element, link to that element.
(should
(let (org-store-link-props org-stored-links)
(org-test-with-temp-text-in-file "#+NAME: foo\nParagraph"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::foo][foo]]" file)
(org-store-link nil))))))
;; Store link to Org buffer, with context.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links t))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*h1][h1]]" file)
(org-store-link nil))))))
;; Store link to Org buffer, without context.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link nil))))))
;; C-u prefix reverses `org-context-in-file-links' in Org buffer.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*h1][h1]]" file)
(org-store-link '(4)))))))
;; A C-u C-u does *not* reverse `org-context-in-file-links' in Org
;; buffer.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link '(16)))))))
;; Store file link to non-Org buffer, with context.
(should
(let ((org-stored-links nil)
(org-link-context-for-files t))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::two]]" file)
(org-store-link nil))))))
;; Store file link to non-Org buffer, without context.
(should
(let ((org-stored-links nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link nil))))))
;; C-u prefix reverses `org-context-in-file-links' in non-Org
;; buffer.
(should
(let ((org-stored-links nil)
(org-link-context-for-files nil))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::two]]" file)
(org-store-link '(4)))))))
;; A C-u C-u does *not* reverse `org-context-in-file-links' in
;; non-Org buffer.
(should
(let ((org-stored-links nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link '(16))))))))
;;; Radio Targets
(ert-deftest test-ol/update-radio-target-regexp ()
"Test `org-update-radio-target-regexp' specifications."
;; Properly update cache with no previous radio target regexp.
(should
(eq 'link
(org-test-with-temp-text "radio\n\nParagraph\n\nradio"
(save-excursion (goto-char (point-max)) (org-element-context))
(insert "<<<")
(search-forward "o")
(insert ">>>")
(org-update-radio-target-regexp)
(goto-char (point-max))
(org-element-type (org-element-context)))))
;; Properly update cache with previous radio target regexp.
(should
(eq 'link
(org-test-with-temp-text "radio\n\nParagraph\n\nradio"
(save-excursion (goto-char (point-max)) (org-element-context))
(insert "<<<")
(search-forward "o")
(insert ">>>")
(org-update-radio-target-regexp)
(search-backward "r")
(delete-char 5)
(insert "new")
(org-update-radio-target-regexp)
(goto-char (point-max))
(delete-region (line-beginning-position) (point))
(insert "new")
(org-element-type (org-element-context))))))
;;; Navigation
(ert-deftest test-ol/next-link ()
"Test `org-next-link' specifications."
;; Move to any type of link.
(should
(equal "[[link]]"
(org-test-with-temp-text "foo [[link]]"
(org-next-link)
(buffer-substring (point) (line-end-position)))))
(should
(equal "http://link"
(org-test-with-temp-text "foo http://link"
(org-next-link)
(buffer-substring (point) (line-end-position)))))
(should
(equal "<http://link>"
(org-test-with-temp-text "foo <http://link>"
(org-next-link)
(buffer-substring (point) (line-end-position)))))
;; Ignore link at point.
(should
(equal "[[link2]]"
(org-test-with-temp-text "[[link1]] [[link2]]"
(org-next-link)
(buffer-substring (point) (line-end-position)))))
;; Ignore fake links.
(should
(equal "[[truelink]]"
(org-test-with-temp-text "foo\n: [[link]]\n[[truelink]]"
(org-next-link)
(buffer-substring (point) (line-end-position)))))
;; Do not move point when there is no link.
(should
(org-test-with-temp-text "foo bar"
(org-next-link)
(bobp)))
;; Wrap around after a failed search.
(should
(equal "[[link]]"
(org-test-with-temp-text "[[link]]\n<point>foo"
(org-next-link)
(let* ((this-command 'org-next-link)
(last-command this-command))
(org-next-link))
(buffer-substring (point) (line-end-position)))))
;; Find links with item tags.
(should
(equal "[[link1]]"
(org-test-with-temp-text "- tag [[link1]] :: description"
(org-next-link)
(buffer-substring (point) (search-forward "]]" nil t))))))
(ert-deftest test-ol/previous-link ()
"Test `org-previous-link' specifications."
;; Move to any type of link.
(should
(equal "[[link]]"
(org-test-with-temp-text "[[link]]\nfoo<point>"
(org-previous-link)
(buffer-substring (point) (line-end-position)))))
(should
(equal "http://link"
(org-test-with-temp-text "http://link\nfoo<point>"
(org-previous-link)
(buffer-substring (point) (line-end-position)))))
(should
(equal "<http://link>"
(org-test-with-temp-text "<http://link>\nfoo<point>"
(org-previous-link)
(buffer-substring (point) (line-end-position)))))
;; Ignore link at point.
(should
(equal "[[link1]]"
(org-test-with-temp-text "[[link1]]\n[[link2<point>]]"
(org-previous-link)
(buffer-substring (point) (line-end-position)))))
(should
(equal "[[link1]]"
(org-test-with-temp-text "line\n[[link1]]\n[[link2<point>]]"
(org-previous-link)
(buffer-substring (point) (line-end-position)))))
;; Ignore fake links.
(should
(equal "[[truelink]]"
(org-test-with-temp-text "[[truelink]]\n: [[link]]\n<point>"
(org-previous-link)
(buffer-substring (point) (line-end-position)))))
;; Do not move point when there is no link.
(should
(org-test-with-temp-text "foo bar<point>"
(org-previous-link)
(eobp)))
;; Wrap around after a failed search.
(should
(equal "[[link]]"
(org-test-with-temp-text "foo\n[[link]]"
(org-previous-link)
(let* ((this-command 'org-previous-link)
(last-command this-command))
(org-previous-link))
(buffer-substring (point) (line-end-position))))))
(provide 'test-ol)
;;; test-ol.el ends here

185
lisp/org/testing/lisp/test-org-agenda.el Normal file
View File

@@ -0,0 +1,185 @@
;;; test-org-agenda.el --- Tests for org-agenda.el -*- lexical-binding: t ; -*-
;; Copyright (C) 2017, 2019 Marco Wahl
;; Author: Marco Wahl <marcowahlsoft@gmail.com>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit tests for Org Agenda.
;;; Code:
(require 'org-test)
(require 'org-agenda)
(eval-and-compile (require 'cl-lib))
;; General auxiliaries
(defun org-test-agenda--agenda-buffers ()
"Return agenda buffers in a list."
(cl-remove-if-not (lambda (x)
(with-current-buffer x
(eq major-mode 'org-agenda-mode)))
(buffer-list)))
(defun org-test-agenda--kill-all-agendas ()
"Kill all agenda buffers."
(mapc #'kill-buffer
(org-test-agenda--agenda-buffers)))
;; Test the Agenda
(ert-deftest test-org-agenda/empty ()
"Empty agenda."
(cl-assert (not org-agenda-sticky) nil "precondition violation")
(cl-assert (not (org-test-agenda--agenda-buffers))
nil "precondition violation")
(let ((org-agenda-span 'day)
org-agenda-files)
(org-agenda-list)
(set-buffer org-agenda-buffer-name)
(should (= 2 (count-lines (point-min) (point-max)))))
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/one-line ()
"One informative line in the agenda."
(cl-assert (not org-agenda-sticky) nil "precondition violation")
(cl-assert (not (org-test-agenda--agenda-buffers))
nil "precondition violation")
(let ((org-agenda-span 'day)
(org-agenda-files `(,(expand-file-name "examples/agenda-file.org"
org-test-dir))))
(org-agenda-list nil "<2017-03-10 Fri>")
(set-buffer org-agenda-buffer-name)
(should (= 3 (count-lines (point-min) (point-max)))))
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/scheduled-non-todo ()
"One informative line in the agenda from scheduled non-todo-keyword-item."
(cl-assert (not org-agenda-sticky) nil "precondition violation")
(cl-assert (not (org-test-agenda--agenda-buffers))
nil "precondition violation")
(let ((org-agenda-span 'day)
(org-agenda-files `(,(expand-file-name "examples/agenda-file.org"
org-test-dir))))
(org-agenda-list nil "<2017-07-19 Wed>")
(set-buffer org-agenda-buffer-name)
(should
(progn (goto-line 3)
(looking-at " *agenda-file:Scheduled: *test agenda"))))
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/set-priority ()
"One informative line in the agenda. Check that org-agenda-priority updates the agenda."
(cl-assert (not org-agenda-sticky) nil "precondition violation")
(cl-assert (not (org-test-agenda--agenda-buffers))
nil "precondition violation")
(let ((org-agenda-span 'day)
(org-agenda-files `(,(expand-file-name "examples/agenda-file.org"
org-test-dir))))
(org-agenda-list nil "<2017-07-19 Wed>")
(set-buffer org-agenda-buffer-name)
(should
(progn (goto-line 3)
(org-agenda-priority ?B)
(looking-at-p " *agenda-file:Scheduled: *\\[#B\\] test agenda"))))
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/sticky-agenda-name ()
"Agenda buffer name after having created one sticky agenda buffer."
(cl-assert (not org-agenda-sticky) nil "precondition violation")
(cl-assert (not (org-test-agenda--agenda-buffers))
nil "precondition violation")
(let ((org-agenda-span 'day)
(buf (get-buffer org-agenda-buffer-name))
org-agenda-files)
(when buf (kill-buffer buf))
(org-test-with-temp-text "<2017-03-17 Fri>"
(org-follow-timestamp-link)) ;creates a sticky agenda
(org-test-agenda--kill-all-agendas)
(org-agenda-list)
(should (= 1 (length (org-test-agenda--agenda-buffers))))
(should (string= "*Org Agenda*"
(buffer-name (car (org-test-agenda--agenda-buffers))))))
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/sticky-agenda-name-after-reload ()
"Agenda buffer name of sticky agenda after reload."
(cl-assert (not org-agenda-sticky) nil "precondition violation")
(cl-assert (not (org-test-agenda--agenda-buffers))
nil "precondition violation")
(org-toggle-sticky-agenda)
(let (org-agenda-files)
(org-agenda-list)
(let* ((agenda-buffer-name
(progn
(cl-assert (= 1 (length (org-test-agenda--agenda-buffers))))
(buffer-name (car (org-test-agenda--agenda-buffers))))))
(set-buffer agenda-buffer-name)
(org-agenda-redo)
(should (= 1 (length (org-test-agenda--agenda-buffers))))
(should (string= agenda-buffer-name
(buffer-name (car (org-test-agenda--agenda-buffers)))))))
(org-toggle-sticky-agenda)
(org-test-agenda--kill-all-agendas))
;; agenda redo
(require 'face-remap)
(ert-deftest test-org-agenda/rescale ()
"Text scale survives `org-agenda-redo'."
(org-test-agenda--kill-all-agendas)
(unwind-protect
(let ((org-agenda-span 'day)
org-agenda-files)
(org-agenda-list)
(set-buffer org-agenda-buffer-name)
(text-scale-mode)
(text-scale-set 11)
(cl-assert (and (boundp text-scale-mode) text-scale-mode))
(org-agenda-redo)
(should text-scale-mode)
(should (= 11 text-scale-mode-amount)))
(org-test-agenda--kill-all-agendas)))
(ert-deftest test-org-agenda/diary-inclusion ()
"Diary inclusion happens."
(org-test-agenda--kill-all-agendas)
(let ((diary-file (expand-file-name "examples/diary-file" org-test-dir))
(org-agenda-files `(,(expand-file-name "examples/agenda-file.org"
org-test-dir)))
(diary-date-forms '((month "[-/]" day "[^-/0-9]")
(year "[-/]" month "[-/]" day "[^0-9]")
(monthname " *" day "[^-0-9]")
(year " *" monthname " *" day "[^0-9]")
(dayname "\\W")))
(org-agenda-span 'day)
(org-agenda-include-diary t))
(org-agenda-list nil "<2019-01-08>")
(should (search-forward "f0bcf0cd8bad93c1451bb6e1b2aaedef5cce7cbb" nil t))
(org-test-agenda--kill-all-agendas)))
(provide 'test-org-agenda)
;;; test-org-agenda.el ends here

142
lisp/org/testing/lisp/test-org-archive.el Normal file
View File

@@ -0,0 +1,142 @@
;;; test-org-archive.el --- Test for Org Archive -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019 Jay Kamat
;; Author: Jay Kamat <jaygkamat@gmail.com>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-org-archive/update-status-cookie ()
"Test archiving properly updating status cookies."
;; Test org-archive-subtree with two children.
(should
(equal
"Top [0%]"
(org-test-with-temp-text-in-file
"* Top [%]\n** DONE One\n** TODO Two"
(forward-line)
(org-archive-subtree)
(forward-line -1)
(org-element-property :title (org-element-at-point)))))
;; Test org-archive-subtree with one child.
(should
(equal
"Top [100%]"
(org-test-with-temp-text-in-file "* Top [%]\n** TODO Two"
(forward-line)
(org-archive-subtree)
(forward-line -1)
(org-element-property :title (org-element-at-point)))))
;; Test org-archive-to-archive-sibling with two children.
(should
(equal
"Top [100%]"
(org-test-with-temp-text "* Top [%]\n<point>** TODO One\n** DONE Two"
(org-archive-to-archive-sibling)
(forward-line -1)
(org-element-property :title (org-element-at-point)))))
;; Test org-archive-to-archive-sibling with two children.
(should
(equal
"Top [0%]"
(org-test-with-temp-text "* Top [%]\n<point>** DONE Two"
(org-archive-to-archive-sibling)
(forward-line -1)
(org-element-property :title (org-element-at-point))))))
(ert-deftest test-org-archive/to-archive-sibling ()
"Test `org-archive-to-archive-sibling' specifications."
;; Archive sibling before or after archive heading.
(should
(equal "* Archive :ARCHIVE:\n** H\n"
(org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE"))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
(point) (line-beginning-position 3))))))
(should
(equal "* Archive :ARCHIVE:\n** H\n"
(org-test-with-temp-text "* Archive :ARCHIVE:\n<point>* H\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE"))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
(point) (line-beginning-position 3))))))
;; When there is no sibling archive heading, create it.
(should
(equal "* Archive :ARCHIVE:\n** H\n"
(org-test-with-temp-text "* H\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE")
(org-tags-column 1))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
(point) (line-beginning-position 3))))))
;; Ignore non-sibling archive headings.
(should
(equal "* Archive :ARCHIVE:\n* Top\n** Archive :ARCHIVE:\n*** H\n"
(org-test-with-temp-text "* Archive :ARCHIVE:\n* Top\n<point>** H\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE")
(org-tags-column 0))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
(point) (line-beginning-position 5))))))
;; When archiving a heading, leave point on next heading.
(should
(equal "* H2"
(org-test-with-temp-text "* H1\n* H2\n* Archive :ARCHIVE:\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE"))
(org-archive-to-archive-sibling)
(buffer-substring-no-properties (point) (line-end-position))))))
(should
(equal "* H2"
(org-test-with-temp-text "* Archive :ARCHIVE:\n<point>* H1\n* H2\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE"))
(org-archive-to-archive-sibling)
(buffer-substring-no-properties (point) (line-end-position))))))
;; If `org-archive-reversed-order' is nil, archive as the last
;; child. Otherwise, archive as the first one.
(should
(equal "* Archive :ARCHIVE:\n** A\n"
(org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n** A\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE")
(org-archive-reversed-order nil))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
(point) (line-beginning-position 3))))))
(should
(equal "* Archive :ARCHIVE:\n** H\n"
(org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n** A\n"
(let ((org-archive-sibling-heading "Archive")
(org-archive-tag "ARCHIVE")
(org-archive-reversed-order t))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
(point) (line-beginning-position 3)))))))
(provide 'test-org-archive)
;;; test-org-archive.el ends here

95
lisp/org/testing/lisp/test-org-attach-git.el Normal file
View File

@@ -0,0 +1,95 @@
;;; test-org-annex-attach.el --- Tests for Org Attach with git-annex
;;
;; Copyright (c) 2016, 2019 Erik Hetzner
;; Authors: Erik Hetzner
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(org-test-for-executable "git-annex")
(require 'org-attach-git)
(require 'cl-lib)
(defmacro test-org-attach-git/with-annex (&rest body)
`(let ((tmpdir (make-temp-file "org-annex-test" t "/")))
(unwind-protect
(let ((default-directory tmpdir)
(org-attach-id-dir tmpdir))
(shell-command "git init")
(shell-command "git annex init")
,@body))))
(ert-deftest test-org-attach-git/use-annex ()
(test-org-attach-git/with-annex
(let ((org-attach-git-annex-cutoff 1))
(should (org-attach-git-use-annex)))
(let ((org-attach-git-annex-cutoff nil))
(should-not (org-attach-git-use-annex))))
;; test with non annex directory
(let ((tmpdir (make-temp-file "org-annex-test" t "/")))
(unwind-protect
(let ((default-directory tmpdir)
(org-attach-id-dir tmpdir))
(shell-command "git init")
(should-not (org-attach-git-use-annex)))
(delete-directory tmpdir 'recursive))))
(ert-deftest test-org-attach-git/get-maybe ()
(test-org-attach-git/with-annex
(let ((path (expand-file-name "test-file"))
(annex-dup (make-temp-file "org-annex-test" t "/")))
(with-temp-buffer
(insert "hello world\n")
(write-file path))
(shell-command "git annex add test-file")
(shell-command "git annex sync")
;; Set up remote & copy files there
(let ((annex-original default-directory)
(default-directory annex-dup))
(shell-command (format "git clone %s ." (shell-quote-argument annex-original)))
(shell-command "git annex init dup")
(shell-command (format "git remote add original %s" (shell-quote-argument annex-original)))
(shell-command "git annex get test-file")
(shell-command "git annex sync"))
(shell-command (format "git remote add dup %s" (shell-quote-argument annex-dup)))
(shell-command "git annex sync")
(shell-command "git annex drop --force test-file")
;; test getting the file from the dup when we should ALWAYS get
(should (not (file-exists-p (file-symlink-p (expand-file-name "test-file")))))
(let ((org-attach-git-annex-auto-get t))
(org-attach-git-annex-get-maybe (expand-file-name "test-file"))
;; check that the file has the right contents
(with-temp-buffer
(insert-file-contents path)
(should (string-equal "hello world\n" (buffer-string)))))
;; test getting the file from the dup when we should NEVER get
(shell-command "git annex drop --force test-file")
(let ((org-attach-git-annex-auto-get nil))
(should-error (org-attach-git-annex-get-maybe (expand-file-name "test-file"))))
(let ((org-attach-git-annex-auto-get 'ask)
(called nil))
(cl-letf (((symbol-function 'y-or-n-p)
(lambda (_) (setq called 'was-called) t)))
(org-attach-git-annex-get-maybe (expand-file-name "test-file"))
;; check that the file has the right contents
(with-temp-buffer
(insert-file-contents path)
(should (string-equal "hello world\n" (buffer-string))))
(should (eq called 'was-called)))))))
;;; test-org-attach-annex.el ends here

173
lisp/org/testing/lisp/test-org-attach.el Normal file
View File

@@ -0,0 +1,173 @@
;;; test-org-attach.el --- tests for org-attach.el -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019
;; Author: Marco Wahl
;; Keywords: internal
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'org-test)
(require 'org-attach)
(eval-and-compile (require 'cl-lib))
(ert-deftest test-org-attach/dir ()
"Test `org-attach-get' specifications."
(should (equal "Text in fileA\n"
(org-test-in-example-file org-test-attachments-file
(goto-char 157) ;; First attachment link
(org-open-at-point)
(buffer-string))))
(should-not (equal "Text in fileB\n"
(org-test-in-example-file org-test-attachments-file
(goto-char 219) ;; Second attachment link
(let ((org-attach-use-inheritance nil))
(org-open-at-point)
(buffer-string)))))
(should (equal "Text in fileB\n"
(org-test-in-example-file org-test-attachments-file
(goto-char 219) ;; Second attachment link
(let ((org-attach-use-inheritance t))
(org-open-at-point)
(buffer-string)))))
(should-not (equal "att1"
(org-test-in-example-file org-test-attachments-file
(goto-char 179) ;; H1.1
(let ((org-attach-use-inheritance nil))
(org-attach-dir)))))
(should (equal "att1"
(org-test-in-example-file org-test-attachments-file
(goto-char 179) ;; H1.1
(let ((org-attach-use-inheritance t))
(org-attach-dir)))))
(should (equal '("fileC" "fileD")
(org-test-in-example-file org-test-attachments-file
(goto-char 239) ;; H1.2
(org-attach-file-list (org-attach-dir)))))
(should (equal '("fileC" "fileD")
(org-test-in-example-file org-test-attachments-file
(goto-char 239) ;; H1.2
(org-attach-file-list (org-attach-dir)))))
(should (equal '("fileE")
(org-test-in-example-file org-test-attachments-file
(goto-char 289) ;; H2
(let ((org-attach-id-dir "data/"))
(org-attach-file-list (org-attach-dir))))))
(should (equal "peek-a-boo\n"
(org-test-in-example-file org-test-attachments-file
(goto-char 289) ;; H2
(let ((org-attach-id-dir "data/"))
(org-attach-open-in-emacs)
(buffer-string)))))
(should (equal '("fileA" "fileB")
(org-test-in-example-file org-test-attachments-file
(goto-char 336) ;; H3
(org-attach-file-list (org-attach-dir)))))
;; Test for folder not initialized in the filesystem
(should-not (org-test-in-example-file org-test-attachments-file
(goto-char 401) ;; H3.1
(let ((org-attach-use-inheritance nil)
(org-attach-id-dir "data/"))
(org-attach-dir))))
;; Not yet initialized folder should be found if no-fs-check is
;; non-nil
(should (equal "data/ab/cd12345"
(org-test-in-example-file org-test-attachments-file
(goto-char 401) ;; H3.1
(let ((org-attach-use-inheritance nil)
(org-attach-id-dir "data/"))
(file-relative-name (org-attach-dir nil t))))))
(should (equal '("fileA" "fileB")
(org-test-in-example-file org-test-attachments-file
(goto-char 401) ;; H3.1
(let ((org-attach-use-inheritance t))
;; This is where it gets a bit sketchy...! DIR always has
;; priority over ID, even if ID is declared "higher up" in the
;; tree. This can potentially be revised. But it is also
;; pretty clean. DIR is always higher in priority than ID right
;; now, no matter the depth in the tree.
(org-attach-file-list (org-attach-dir)))))))
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/1 ()
"Attach file at point in dired to subtree."
(should
(let ((a-filename (make-temp-file "a")) ; file is an attach candidate.
(org-attach-id-dir "data/"))
(unwind-protect
(org-test-with-temp-text-in-file
"* foo :foo:"
(split-window)
(let ((org-buffer (current-buffer))
(dired-buffer (dired temporary-file-directory)))
(cl-assert (eq 'dired-mode major-mode))
(revert-buffer)
(dired-goto-file a-filename)
; action
(call-interactively #'org-attach-dired-to-subtree)
; check
(delete-window)
(switch-to-buffer org-buffer)
(cl-assert (eq 'org-mode major-mode)))
(beginning-of-buffer)
(search-forward "* foo")
; expectation. tag ATTACH has been appended.
(cl-reduce (lambda (x y) (or x y))
(mapcar (lambda (x) (string-equal "ATTACH" x))
(plist-get
(plist-get
(org-element-at-point) 'headline) :tags))))
(delete-file a-filename)))))
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()
"Attach 2 marked files."
(should
(let ((a-filename (make-temp-file "a"))
(b-filename (make-temp-file "b")) ; attach candidates.
(org-attach-id-dir "data/"))
(unwind-protect
(org-test-with-temp-text-in-file
"* foo"
(split-window)
(let ((org-buffer (current-buffer))
(dired-buffer (dired temporary-file-directory)))
(cl-assert (eq 'dired-mode major-mode))
(revert-buffer)
(dired-goto-file a-filename)
(dired-mark 1)
(dired-goto-file b-filename)
(dired-mark 1)
; action
(call-interactively #'org-attach-dired-to-subtree)
; check
(delete-window)
(switch-to-buffer org-buffer))
(cl-assert (eq 'org-mode major-mode))
(beginning-of-buffer)
(search-forward "* foo")
(and (file-exists-p (concat (org-attach-dir) "/"
(file-name-nondirectory a-filename)))
(file-exists-p (concat (org-attach-dir) "/"
(file-name-nondirectory b-filename)))))
(delete-file a-filename)
(delete-file b-filename)))))
(provide 'test-org-attach)
;;; test-org-attach.el ends here

748
lisp/org/testing/lisp/test-org-capture.el Normal file
View File

@@ -0,0 +1,748 @@
;;; test-org-capture.el --- Tests for org-capture.el -*- lexical-binding: t; -*-
;; Copyright (C) 2015, 2017, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit tests for Org Capture library.
;;; Code:
(require 'org-capture)
(ert-deftest test-org-capture/fill-template ()
"Test `org-capture-fill-template' specifications."
;; When working on these tests consider to also change
;; `test-org-feed/fill-template'.
;; %(sexp) placeholder.
(should
(equal "success!\n"
(org-capture-fill-template "%(concat \"success\" \"!\")")))
;; It is possible to include other place holders in %(sexp). In
;; that case properly escape \ and " characters.
(should
(equal "Nested string \"\\\"\\\"\"\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "%(concat \"%i\")"
"Nested string \"\\\"\\\"\""))))
;; %<...> placeholder.
(should
(equal (concat (format-time-string "%Y") "\n")
(org-capture-fill-template "%<%Y>")))
;; %t and %T placeholders.
(should
(equal (concat (format-time-string (org-time-stamp-format nil nil)) "\n")
(org-capture-fill-template "%t")))
(should
(equal (concat (format-time-string (org-time-stamp-format t nil)) "\n")
(org-capture-fill-template "%T")))
;; %u and %U placeholders.
(should
(equal
(concat (format-time-string (org-time-stamp-format nil t)) "\n")
(org-capture-fill-template "%u")))
(should
(equal
(concat (format-time-string (org-time-stamp-format t t)) "\n")
(org-capture-fill-template "%U")))
;; %i placeholder. Make sure sexp placeholders are not expanded
;; when they are inserted through this one.
(should
(equal "success!\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "%i" "success!"))))
(should
(equal "%(concat \"no \" \"evaluation\")\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template
"%i" "%(concat \"no \" \"evaluation\")"))))
;; When %i contents span over multiple line, repeat initial leading
;; characters over each line. Also try possibly problematic
;; prefixes such as "\\".
(should
(equal "> line 1\n> line 2\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "> %i" "line 1\nline 2"))))
(should
(equal "\\ line 1\n\\ line 2\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\ %i" "line 1\nline 2"))))
;; Test %-escaping with \ character.
(should
(equal "%i\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\%i" "success!"))))
(should
(equal "\\success!\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\\\%i" "success!"))))
(should
(equal "\\%i\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\\\\\%i" "success!"))))
;; More than one placeholder in the same template.
(should
(equal "success! success! success! success!\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "%i %i %i %i" "success!"))))
;; %(sexp) placeholder with an input containing the traps %, " and )
;; all at once which is complicated to parse.
(should
(equal "5 % Less (See Item \"3)\" Somewhere)\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template
"%(capitalize \"%i\")"
"5 % less (see item \"3)\" somewhere)")))))
(ert-deftest test-org-capture/refile ()
"Test `org-capture-refile' specifications."
;; When refiling, make sure the headline being refiled is the one
;; being captured. In particular, empty lines after the entry may
;; be removed, and we don't want to shift onto the next heading.
(should
(string-prefix-p
"** H1"
(org-test-with-temp-text-in-file "* A\n* B\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Todo" entry (file+headline ,file "A") "** H1 %?"))))
(org-capture nil "t")
(insert "\n")
(cl-letf (((symbol-function 'org-refile)
(lambda ()
(interactive)
(throw :return
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))))
(catch :return (org-capture-refile)))))))
;; When the entry is refiled, `:jump-to-captured' moves point to the
;; refile location, not the initial capture target.
(should
(org-test-with-temp-text-in-file "* Refile target"
(let ((file1 (buffer-file-name)))
(org-test-with-temp-text-in-file "* A"
(let* ((file2 (buffer-file-name))
(org-capture-templates
`(("t" "Todo" entry (file+headline ,file2 "A")
"** H1 %?" :jump-to-captured t))))
(org-capture nil "t")
(cl-letf (((symbol-function 'org-refile-get-location)
(lambda (&rest args)
(list (file-name-nondirectory file1) file1 nil nil))))
(org-capture-refile)
(list file1 file2 (buffer-file-name)))))))))
(ert-deftest test-org-capture/abort ()
"Test aborting a capture process."
;; Test that capture can be aborted after inserting at end of
;; capture buffer.
(should
(equal
"* A\n* B\n"
(org-test-with-temp-text-in-file "* A\n* B\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Todo" entry (file+headline ,file "A") "** H1 %?"))))
(org-capture nil "t")
(goto-char (point-max))
(insert "Capture text")
(org-capture-kill))
(buffer-string))))
(should
(equal "- A\n - B\n"
(org-test-with-temp-text-in-file "- A\n - B"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X"))))
(org-capture nil "t")
(org-capture-kill))
(buffer-string))))
(should
(equal "| a |\n| b |\n"
(org-test-with-temp-text-in-file "| a |\n| b |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file) "| x |"))))
(org-capture nil "t")
(org-capture-kill))
(buffer-string))))
;; Test aborting a capture that split the line.
(should
(equal
"* AB\n"
(org-test-with-temp-text-in-file "* AB\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Todo" entry
(file+function ,file (lambda () (goto-char 4))) "** H1 %?"))))
(org-capture nil "t")
(org-capture-kill))
(buffer-string)))))
(ert-deftest test-org-capture/entry ()
"Test `entry' type in capture template."
;; Do not break next headline.
(should
(equal
"* A\n** H1 Capture text\n* B\n"
(org-test-with-temp-text-in-file "* A\n* B\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Todo" entry (file+headline ,file "A") "** H1 %?"))))
(org-capture nil "t")
(insert "Capture text")
(org-capture-finalize))
(buffer-string))))
;; Correctly save position of inserted entry.
(should
(equal
"** H"
(org-test-with-temp-text-in-file "* A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" entry (file+headline ,file "A") "** H\nFoo"
:immediate-finish t))))
(org-capture nil "t")
(org-capture '(16))
(buffer-substring (point) (line-end-position))))))
;; Do not raise an error on empty entries.
(should
(org-test-with-temp-text-in-file ""
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" entry (file+headline ,file "A") "** "
:immediate-finish t))))
(org-capture nil "t")
(buffer-string))))
;; With a 0 prefix argument, ignore surrounding lists.
(should
(equal "Foo\n* X\nBar\n"
(org-test-with-temp-text-in-file "Foo\nBar"
(forward-line)
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" entry (file ,file) "* X"
:immediate-finish t))))
(org-capture 0 "t")
(buffer-string)))))
;; With a 0 prefix argument, also obey to :empty-lines.
(should
(equal "Foo\n\n* X\n\nBar\n"
(org-test-with-temp-text-in-file "Foo\nBar"
(forward-line)
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" entry (file ,file) "* X"
:immediate-finish t :empty-lines 1))))
(org-capture 0 "t")
(buffer-string))))))
(ert-deftest test-org-capture/item ()
"Test `item' type in capture template."
;; Insert item in the first plain list found at the target location.
(should
(equal
"* A\n- list 1\n- X\n\n\n1. list 2\n"
(org-test-with-temp-text-in-file "* A\n- list 1\n\n\n1. list 2"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+headline ,file "A") "- X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
(should
(equal
"Text\n- list 1\n- X\n\n\n1. list 2\n"
(org-test-with-temp-text-in-file "Text\n- list 1\n\n\n1. list 2"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; When targeting a specific location, start looking for plain lists
;; from there.
(should
(equal
"* A\n- skip\n\n\n1. here\n2. X\n"
(org-test-with-temp-text-in-file "* A\n- skip\n\n\n1. here"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+regexp ,file "here") "1. X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; If there is no such list, create it.
(should
(equal
"* A\n- X\n"
(org-test-with-temp-text-in-file "* A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+headline ,file "A") "- X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; When `:prepend' is non-nil, insert new item as the first item.
(should
(equal
"* A\n- X\n- 1\n- 2\n"
(org-test-with-temp-text-in-file "* A\n- 1\n- 2"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+headline ,file "A") "- X"
:prepend t))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; If there is no list and `:prepend' is non-nil, insert list at the
;; beginning of the entry, or the beginning of the buffer. However,
;; preserve properties drawer and planning info, if any.
(should
(equal
"* A\n- X\nSome text\n"
(org-test-with-temp-text-in-file "* A\nSome text"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+headline ,file "A") "- X"
:prepend t))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
(should
(equal
"- X\nText\n"
(org-test-with-temp-text-in-file "Text"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X" :prepend t))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
(should
(equal
"* A\nSCHEDULED: <2012-03-29 Thu>\n- X\nText\n"
(org-test-with-temp-text-in-file "* A\nSCHEDULED: <2012-03-29 Thu>\nText"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+headline ,file "A") "- X"
:prepend t))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; When `:prepend' is nil, insert new item as the last top-level
;; item.
(should
(equal
"* A\n- 1\n - 2\n- X\n"
(org-test-with-temp-text-in-file "* A\n- 1\n - 2"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+headline ,file "A") "- X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; When targeting a specific location, one can insert in a sub-list.
(should
(equal
"* A\n- skip\n - here\n - X\n- skip\n"
(org-test-with-temp-text-in-file "* A\n- skip\n - here\n- skip"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file+regexp ,file "here") "- X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; Obey `:empty-lines' when creating a new list.
(should
(equal
"\n- X\n\n\n* H\n"
(org-test-with-temp-text-in-file "\n* H"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X"
:empty-lines-before 1 :empty-lines-after 2 :prepend t))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; Obey `:empty-lines' in an existing list only between items, and
;; only if the value doesn't break the list.
(should
(equal
"- A\n\n- X\nText\n"
(org-test-with-temp-text-in-file "- A\nText"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X" :empty-lines 1))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
(should
(equal
"Text\n- X\n\n- A\n"
(org-test-with-temp-text-in-file "Text\n- A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X"
:prepend t :empty-lines 1))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
(should-not
(equal
"- A\n\n\n- X\n"
(org-test-with-temp-text-in-file "- A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X" :empty-lines 2))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; Preserve list type when pre-pending.
(should
(equal
"1. X\n2. A\n"
(org-test-with-temp-text-in-file "1. A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X" :prepend t))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; Handle indentation. Handle multi-lines templates.
(should
(equal
" - A\n - X\n"
(org-test-with-temp-text-in-file " - A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
(should
(equal
" - A\n - X\n Line 2\n"
(org-test-with-temp-text-in-file " - A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X\n Line 2"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; Handle incomplete templates.
(should
(equal
"- A\n- X\n"
(org-test-with-temp-text-in-file "- A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "X"))))
(org-capture nil "t")
(org-capture-finalize))
(buffer-string))))
;; Do not break next headline.
(should-not
(equal
"- A\n- X\nFoo* H"
(org-test-with-temp-text-in-file "- A\n* H"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Item" item (file ,file) "- X"))))
(org-capture nil "t")
(goto-char (point-max))
(insert "Foo")
(org-capture-finalize))
(buffer-string))))
;; With a 0 prefix argument, ignore surrounding lists.
(should
(equal "- X\nFoo\n\n- A\n"
(org-test-with-temp-text-in-file "Foo\n\n- A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" item (file ,file) "- X"
:immediate-finish t))))
(org-capture 0 "t")
(buffer-string)))))
;; With a 0 prefix argument, also obey to `:empty-lines'.
(should
(equal "\n- X\n\nFoo\n\n- A\n"
(org-test-with-temp-text-in-file "Foo\n\n- A"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" item (file ,file) "- X"
:immediate-finish t :empty-lines 1))))
(org-capture 0 "t")
(buffer-string))))))
(ert-deftest test-org-capture/table-line ()
"Test `table-line' type in capture template."
;; When a only file is specified, use the first table available.
(should
(equal "Text
| a |
| x |
| b |
"
(org-test-with-temp-text-in-file "Text\n\n| a |\n\n| b |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file) "| x |"
:immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
;; When an entry is specified, find the first table in the
;; corresponding section.
(should
(equal "* Foo
| a |
* Inbox
| b |
| x |
"
(org-test-with-temp-text-in-file "* Foo\n| a |\n* Inbox\n| b |\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file+headline ,file "Inbox")
"| x |" :immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
(should
(equal "* Inbox
| a |
| x |
| b |
"
(org-test-with-temp-text-in-file "* Inbox\n| a |\n\n| b |\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file+headline ,file "Inbox")
"| x |" :immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
;; When a precise location is specified, find the first table after
;; point, down to the end of the section.
(should
(equal "| a |
| b |
| x |
"
(org-test-with-temp-text-in-file "| a |\n\n\n| b |\n"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file+function ,file forward-line)
"| x |" :immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
;; Create a new table with an empty header when none can be found.
(should
(equal "| | |\n|---+---|\n| a | b |\n"
(org-test-with-temp-text-in-file ""
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file) "| a | b |"
:immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
;; Properly insert row with formulas.
(should
(equal "| 1 |\n| 2 |\n#+TBLFM: \n"
(org-test-with-temp-text-in-file "| 1 |\n#+TBLFM: "
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| 2 |" :immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
;; When `:prepend' is nil, add the row at the end of the table.
(should
(equal "| a |\n| x |\n"
(org-test-with-temp-text-in-file "| a |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| x |" :immediate-finish t))))
(org-capture nil "t"))
(buffer-string))))
;; When `:prepend' is non-nil, add it as the first row after the
;; header, if there is one, or the first row otherwise.
(should
(equal "| a |\n|---|\n| x |\n| b |\n"
(org-test-with-temp-text-in-file "| a |\n|---|\n| b |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| x |" :immediate-finish t :prepend t))))
(org-capture nil "t"))
(buffer-string))))
(should
(equal "| x |\n| a |\n"
(org-test-with-temp-text-in-file "| a |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| x |" :immediate-finish t :prepend t))))
(org-capture nil "t"))
(buffer-string))))
;; When `:table-line-pos' is set and is meaningful, obey it.
(should
(equal "| a |\n|---|\n| b |\n| x |\n|---|\n| c |\n"
(org-test-with-temp-text-in-file "| a |\n|---|\n| b |\n|---|\n| c |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| x |" :immediate-finish t :table-line-pos "II-1"))))
(org-capture nil "t"))
(buffer-string))))
(should
(equal "| a |\n|---|\n| x |\n| b |\n|---|\n| c |\n"
(org-test-with-temp-text-in-file "| a |\n|---|\n| b |\n|---|\n| c |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| x |" :immediate-finish t :table-line-pos "I+1"))))
(org-capture nil "t"))
(buffer-string))))
;; Throw an error on invalid `:table-line-pos' specifications.
(should-error
(org-test-with-temp-text-in-file "| a |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| x |" :immediate-finish t :table-line-pos "II+99"))))
(org-capture nil "t")
t)))
;; Update formula when capturing one or more rows.
(should
(equal
'(("@3$1" . "9"))
(org-test-with-temp-text-in-file "| 1 |\n|---|\n| 9 |\n#+tblfm: @2$1=9"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| 2 |" :immediate-finish t :table-line-pos "I-1"))))
(org-capture nil "t")
(org-table-get-stored-formulas)))))
(should
(equal
'(("@4$1" . "9"))
(org-test-with-temp-text-in-file "| 1 |\n|---|\n| 9 |\n#+tblfm: @2$1=9"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| 2 |\n| 3 |" :immediate-finish t :table-line-pos "I-1"))))
(org-capture nil "t")
(org-table-get-stored-formulas)))))
;; Do not update formula when cell in inserted below affected row.
(should-not
(equal
'(("@3$1" . "9"))
(org-test-with-temp-text-in-file "| 1 |\n|---|\n| 9 |\n#+tblfm: @2$1=9"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Table" table-line (file ,file)
"| 2 |" :immediate-finish t))))
(org-capture nil "t")
(org-table-get-stored-formulas)))))
;; With a 0 prefix argument, ignore surrounding tables.
(should
(equal "| |\n|---|\n| B |\nFoo\n\n| A |\n"
(org-test-with-temp-text-in-file "Foo\n\n| A |"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Test" table-line (file ,file) "| B |"
:immediate-finish t))))
(org-capture 0 "t")
(buffer-string))))))
(ert-deftest test-org-capture/plain ()
"Test `plain' type in capture template."
;; Insert at end of the file, unless `:prepend' is non-nil.
(should
(equal "Some text.\nFoo\n"
(org-test-with-temp-text-in-file "Some text."
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Text" plain (file ,file) "Foo"
:immediate-finish t))))
(org-capture nil "t")
(buffer-string)))))
(should
(equal "Foo\nSome text.\n"
(org-test-with-temp-text-in-file "Some text."
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Text" plain (file ,file) "Foo"
:immediate-finish t :prepend t))))
(org-capture nil "t")
(buffer-string)))))
;; When a headline is specified, add it at the beginning of the
;; entry, past any meta-data, or at its end, depending on
;; `:prepend'.
(should
(equal "* A\nSCHEDULED: <2012-03-29 Thu>\nSome text.\nFoo\n* B\n"
(org-test-with-temp-text-in-file
"* A\nSCHEDULED: <2012-03-29 Thu>\nSome text.\n* B"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Text" plain (file+headline ,file "A") "Foo"
:immediate-finish t))))
(org-capture nil "t")
(buffer-string)))))
(should
(equal "* A\nSCHEDULED: <2012-03-29 Thu>\nFoo\nSome text.\n* B\n"
(org-test-with-temp-text-in-file
"* A\nSCHEDULED: <2012-03-29 Thu>\nSome text.\n* B"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Text" plain (file+headline ,file "A") "Foo"
:immediate-finish t :prepend t))))
(org-capture nil "t")
(buffer-string)))))
;; At an exact position, in the middle of a line, make sure to
;; insert text on a line on its own.
(should
(equal "A\nX\nB\n"
(org-test-with-temp-text-in-file "AB"
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Text" plain (file+function ,file forward-char) "X"
:immediate-finish t))))
(org-capture nil "t")
(buffer-string)))))
;; Pathological case: insert an empty template in an empty file.
(should
(equal ""
(org-test-with-temp-text-in-file ""
(let* ((file (buffer-file-name))
(org-capture-templates
`(("t" "Text" plain (file ,file) ""
:immediate-finish t))))
(org-capture nil "t")
(buffer-string))))))
(provide 'test-org-capture)
;;; test-org-capture.el ends here

1170
lisp/org/testing/lisp/test-org-clock.el Normal file
View File

File diff suppressed because it is too large Load Diff

1525
lisp/org/testing/lisp/test-org-colview.el Normal file
View File

File diff suppressed because it is too large Load Diff

209
lisp/org/testing/lisp/test-org-datetree.el Normal file
View File

@@ -0,0 +1,209 @@
;;; test-org-datetree.el --- Tests for Org Datetree -*- lexical-binding: t; -*-
;; Copyright (C) 2015, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-org-datetree/find-date-create ()
"Test `org-datetree-find-date-create' specifications."
;; When date is missing, create it.
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-03 .*\n\\*\\*\\* 2012-03-29 .*\\'"
(org-test-with-temp-text ""
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
;; Do not create new year node when one exists.
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-03 .*\n\\*\\*\\* 2012-03-29 .*\\'"
(org-test-with-temp-text "* 2012\n"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
;; Do not create new month node when one exists.
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-03 .*\n\\*\\*\\* 2012-03-29 .*\\'"
(org-test-with-temp-text "* 2012\n** 2012-03 month"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
;; Do not create new day node when one exists.
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-03 .*\n\\*\\*\\* 2012-03-29 .*\\'"
(org-test-with-temp-text "* 2012\n** 2012-03 month\n*** 2012-03-29 day"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
;; Sort new entry in right place.
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-02 .*\n\\*\\*\\* 2012-02-01 .*\n\n\\*\\* 2012-03 .*\n\\*\\*\\* 2012-03-29 .*\\'"
(org-test-with-temp-text "* 2012\n** 2012-03 month\n*** 2012-03-29 day"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012))
(org-datetree-find-date-create '(2 1 2012)))
(org-trim (buffer-string)))))
;; When `org-datetree-add-timestamp' is non-nil, insert a timestamp
;; in entry. When set to `inactive', insert an inactive one.
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-03 .*\n\\*\\*\\* \\(2012-03-29\\) .*\n[ \t]*<\\1.*?>\\'"
(org-test-with-temp-text "* 2012\n"
(let ((org-datetree-add-timestamp t))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
(should
(string-match
"\\`\\* 2012\n\\*\\* 2012-03 .*\n\\*\\*\\* \\(2012-03-29\\) .*\n[ \t]*\\[\\1.*?\\]\\'"
(org-test-with-temp-text "* 2012\n"
(let ((org-datetree-add-timestamp 'inactive))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
;; Insert at top level, unless some node has DATE_TREE property. In
;; this case, date tree becomes one of its sub-trees.
(should
(string-match
"\\* 2012"
(org-test-with-temp-text "* Top"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
(should
(string-match
"\\*\\* H1.1\n:PROPERTIES:\n:DATE_TREE: t\n:END:\n\\*\\*\\* 2012"
(org-test-with-temp-text
"* H1\n** H1.1\n:PROPERTIES:\n:DATE_TREE: t\n:END:\n* H2"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
;; Always leave point at beginning of day entry.
(should
(string-match
"\\*\\*\\* 2012-03-29"
(org-test-with-temp-text "* 2012\n** 2012-03 month\n*** 2012-03-29 day"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(buffer-substring (point) (line-end-position)))))
(should
(string-match
"\\*\\*\\* 2012-03-29"
(org-test-with-temp-text "* 2012\n** 2012-03 month\n*** 2012-03-29 day"
(let ((org-datetree-add-timestamp t))
(org-datetree-find-date-create '(3 29 2012)))
(buffer-substring (point) (line-end-position))))))
(ert-deftest test-org-datetree/find-iso-week-create ()
"Test `org-datetree-find-iso-date-create' specificaiton."
;; When date is missing, create it.
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
(org-test-with-temp-text ""
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; Do not create new year node when one exists.
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
(org-test-with-temp-text "* 2015\n"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; Do not create new month node when one exists.
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
(org-test-with-temp-text "* 2015\n** 2015-W01"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; Do not create new day node when one exists.
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
(org-test-with-temp-text "* 2015\n** 2015-W01\n*** 2014-12-31 day"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; Sort new entry in right place.
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\n\n\\*\\* 2015-W36\n\\*\\*\\* 2015-09-01 .*\\'"
(org-test-with-temp-text "* 2015"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(9 1 2015))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; When `org-datetree-add-timestamp' is non-nil, insert a timestamp
;; in entry. When set to `inactive', insert an inactive one.
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* \\(2014-12-31\\) .*\n[ \t]*<\\1.*?>\\'"
(org-test-with-temp-text "* 2015\n"
(let ((org-datetree-add-timestamp t))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
(should
(string-match
"\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* \\(2014-12-31\\) .*\n[ \t]*\\[\\1.*?\\]\\'"
(org-test-with-temp-text "* 2015\n"
(let ((org-datetree-add-timestamp 'inactive))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; Insert at top level, unless some node has WEEK_TREE property. In
;; this case, date tree becomes one of its sub-trees.
(should
(string-match
"\\* 2015"
(org-test-with-temp-text "* Top"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
(should
(string-match
"\\*\\* H1.1\n:PROPERTIES:\n:WEEK_TREE: t\n:END:\n\\*\\*\\* 2015"
(org-test-with-temp-text
"* H1\n** H1.1\n:PROPERTIES:\n:WEEK_TREE: t\n:END:\n* H2"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(org-trim (buffer-string)))))
;; Always leave point at beginning of day entry.
(should
(string-match
"\\*\\*\\* 2014-12-31"
(org-test-with-temp-text "* 2015\n** 2015-W01\n*** 2014-12-31 day"
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-iso-week-create '(12 31 2014)))
(buffer-substring (point) (line-end-position)))))
(should
(string-match
"\\*\\*\\* 2014-12-31"
(org-test-with-temp-text "* 2015\n** 2015-W01\n*** 2014-12-31 day"
(let ((org-datetree-add-timestamp t))
(org-datetree-find-iso-week-create '(12 31 2014)))
(buffer-substring (point) (line-end-position))))))
(provide 'test-org-datetree)
;;; test-org-datetree.el ends here

160
lisp/org/testing/lisp/test-org-duration.el Normal file
View File

@@ -0,0 +1,160 @@
;;; test-org-duration.el --- Tests for org-duration.el -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-org-duration/to-minutes ()
"Test `org-duration-to-minutes' specifications."
;; Raise an error for unknown duration format.
(should-error (org-duration-to-minutes "1:2"))
;; Return number of minutes, as a float.
(should (= (org-duration-to-minutes "1:01") 61))
(should (floatp (org-duration-to-minutes "1:01")))
;; Handle various duration formats.
(should (= (org-duration-to-minutes "1:20:30") 80.5))
(should (= (org-duration-to-minutes "2h 10min") 130))
(should (= (org-duration-to-minutes "1d 1:02") 1502))
(should (= (org-duration-to-minutes "2.5h") 150))
;; Special case: a bare number is treated as minutes.
(should (= (org-duration-to-minutes "2") 2))
(should (= (org-duration-to-minutes "2.5") 2.5))
(should (= (org-duration-to-minutes 1) 1))
;; Special case: the empty string is 0.0.
(should (= (org-duration-to-minutes "") 0.0))
;; Support custom units.
(should (= 4
(let ((org-duration-units '(("longmin" . 2)))
org-duration--unit-re
org-duration--full-re
org-duration--mixed-re)
(org-duration-set-regexps)
(org-duration-to-minutes "2longmin"))))
(should (= 61
(let ((org-duration-units '(("h" . 61)))
org-duration--unit-re
org-duration--full-re
org-duration--mixed-re)
(org-duration-set-regexps)
(org-duration-to-minutes "1h"))))
;; When CANONICAL is non-nil, ignore custom units and only recognize
;; units defined in `org-duration-canonical-units'.
(should (= 60
(let ((org-duration-units '(("h" . 61)))
org-duration--unit-re
org-duration--full-re
org-duration--mixed-re)
(org-duration-set-regexps)
(org-duration-to-minutes "1h" t))))
(should-error (let ((org-duration-units '(("longmin" . 2)))
org-duration--unit-re
org-duration--full-re
org-duration--mixed-re)
(org-duration-set-regexps)
(org-duration-to-minutes "2longmin" t))))
(ert-deftest test-org-duration/from-minutes ()
"Test `org-duration-from-minutes' specifications."
;; Format number of minutes according to `org-duration-format'.
(should (equal "1:00"
(let ((org-duration-format 'h:mm))
(org-duration-from-minutes 60))))
(should (equal "1:01:30"
(let ((org-duration-format 'h:mm:ss))
(org-duration-from-minutes 61.5))))
(should (equal "1:01"
(let ((org-duration-format 'h:mm))
(org-duration-from-minutes 61.5))))
;; Handle required parameter in advanced format specifications.
(should (equal "1h"
(let ((org-duration-format '(("h" . nil) ("min" . nil))))
(org-duration-from-minutes 60))))
(should (equal "1h 0min"
(let ((org-duration-format '(("h" . nil) ("min" . t))))
(org-duration-from-minutes 60))))
(should (equal "50min"
(let ((org-duration-format '(("h" . nil) ("min" . nil))))
(org-duration-from-minutes 50))))
(should (equal "0h 50min"
(let ((org-duration-format '(("h" . t) ("min" . t))))
(org-duration-from-minutes 50))))
;; Handle mixed mode.
(should (equal "1d 0:10"
(let ((org-duration-format '(("d" . nil) (special . h:mm))))
(org-duration-from-minutes (+ (* 24 60) 10)))))
(should (equal "1d 0:12:30"
(let ((org-duration-format '(("d" . nil) (special . h:mm:ss))))
(org-duration-from-minutes (+ (* 24 60) 12.5)))))
;; Handle fractional duration. Parameter is the precision.
(should (equal "1.5h"
(let ((org-duration-format '(("h" . nil) (special . 1))))
(org-duration-from-minutes 90))))
(should (equal "1.50h"
(let ((org-duration-format '(("h" . nil) (special . 2))))
(org-duration-from-minutes 90))))
;; When using fractional duration, use first required unit or the
;; first with a non-zero integer part. If none is found, refer to
;; smallest unit specified in format.
(should (equal "0.7h"
(let ((org-duration-format
'(("h" . t) ("min" . nil) (special . 1))))
(org-duration-from-minutes 40))))
(should (equal "40.0min"
(let ((org-duration-format
'(("h" . nil) ("min" . nil) (special . 1))))
(org-duration-from-minutes 40))))
(should (equal "0.5min"
(let ((org-duration-format
'(("h" . nil) ("min" . nil) (special . 1))))
(org-duration-from-minutes 0.5)))))
(ert-deftest test-org-duration/p ()
"Test `org-duration-p' specifications."
;; Test all duration formats.
(should (org-duration-p "3:12"))
(should (org-duration-p "123:12"))
(should (org-duration-p "1:23:45"))
(should (org-duration-p "3d 3h 4min"))
(should (org-duration-p "3d 13:35"))
(should (org-duration-p "2.35h"))
;; Handle custom units, but return nil for unknown units.
(should-not (org-duration-p "1minute"))
(should (let ((org-duration-units '(("minute" . 1)))
org-duration--unit-re
org-duration--full-re
org-duration--mixed-re)
(org-duration-set-regexps)
(org-duration-p "2minute")))
;; Tolerate white space between the number and the unit.
(should (org-duration-p "2 h"))
;; Return nil for ill-formed H:MM:SS strings.
(should-not (org-duration-p "3::12"))
(should-not (org-duration-p "3:2"))
(should-not (org-duration-p "3:12:4"))
;; Return nil in mixed mode if H:MM:SS part is not last.
(should-not (org-duration-p "3d 13:35 13h")))
(ert-deftest test-org-duration/h:mm-only-p ()
"Test `org-duration-h:mm-only-p' specifications."
(should (org-duration-h:mm-only-p '("123:31" "1:00")))
(should-not (org-duration-h:mm-only-p '("123:32" "1h")))
(should (eq 'h:mm:ss (org-duration-h:mm-only-p '("3:33" "1:23:45")))))
(provide 'test-org-duration)
;;; test-org-duration.el ends here

3871
lisp/org/testing/lisp/test-org-element.el Normal file
View File

File diff suppressed because it is too large Load Diff

112
lisp/org/testing/lisp/test-org-feed.el Normal file
View File

@@ -0,0 +1,112 @@
;;; test-org-feed.el --- Tests for org-feed.el -*- lexical-binding: t; -*-
;; Copyright (C) 2016, 2019 Michael Brand
;; Author: Michael Brand <michael.ch.brand@gmail.com>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit tests for Org Feed library.
;;; Code:
(require 'org-feed)
(ert-deftest test-org-feed/fill-template ()
"Test `org-feed-format-entry' template specifications."
;; When working on these tests consider to also change
;; `test-org-capture/fill-template'.
;; %(sexp) placeholder.
(should
(equal "success!"
(org-feed-format-entry nil "%(concat \"success\" \"!\")" nil)))
;; %a placeholder.
(should
(equal "[[https://orgmode.org]]\n"
(org-feed-format-entry '(:link "https://orgmode.org") "%a" nil)))
;; %t and %T placeholders.
(should
(equal (format-time-string (org-time-stamp-format nil nil))
(org-feed-format-entry nil "%t" nil)))
(should
(string-match-p
"<2016-01-02 \\S-+>"
(org-feed-format-entry
'(:pubDate "Sat, 02 Jan 2016 12:00:00 +0000") "%t" nil)))
(should
(equal (format-time-string (org-time-stamp-format t nil))
(org-feed-format-entry nil "%T" nil)))
(should
(string-match-p
"<2016-01-02 \\S-+ 12:00>"
(org-feed-format-entry
'(:pubDate "Sat, 02 Jan 2016 12:00:00 +0000") "%T" nil)))
;; %u and %U placeholders.
(should
(equal (format-time-string (org-time-stamp-format nil t))
(org-feed-format-entry nil "%u" nil)))
(should
(string-match-p
"[2016-01-02 \\S-+]"
(org-feed-format-entry
'(:pubDate "Sat, 02 Jan 2016 12:00:00 +0000") "%u" nil)))
(should
(equal (format-time-string (org-time-stamp-format t t))
(org-feed-format-entry nil "%U" nil)))
(should
(string-match-p
"[2016-01-02 \\S-+ 12:00]"
(org-feed-format-entry
'(:pubDate "Sat, 02 Jan 2016 12:00:00 +0000") "%U" nil)))
;; %h placeholder. Make sure sexp placeholders are not expanded
;; when they are inserted through this one.
(should
(equal "success!"
(org-feed-format-entry '(:title "success!") "%h" nil)))
(should
(equal "%(concat \"no \" \"evaluation\")"
(org-feed-format-entry
'(:title "%(concat \"no \" \"evaluation\")") "%h" nil)))
;; Test %-escaping with \ character.
(should
(equal "%h"
(org-feed-format-entry '(:title "success!") "\\%h" nil)))
(should
(equal "\\success!"
(org-feed-format-entry '(:title "success!") "\\\\%h" nil)))
(should
(equal "\\%h"
(org-feed-format-entry '(:title "success!") "\\\\\\%h" nil)))
;; More than one placeholder in the same template.
(should
(equal "success! success! success! success!"
(org-feed-format-entry '(:title "success!") "%h %h %h %h" nil)))
;; %(sexp) placeholder with an input containing the traps %, ", )
;; and \n all at once which is complicated to parse.
(should
(equal
"5 % Less (See\n Item \"3)\" Somewhere)"
(org-feed-format-entry
'(:title "5 % less (see\n item \"3)\" somewhere)")
"%(capitalize \"%h\")" nil))))
(provide 'test-org-feed)
;;; test-org-feed.el ends here

682
lisp/org/testing/lisp/test-org-footnote.el Normal file
View File

@@ -0,0 +1,682 @@
;;; test-org-footnote.el --- Tests for org-footnote.el
;; Copyright (C) 2012-2015, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail at nicolasgoaziou dot fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-org-footnote/new ()
"Test `org-footnote-new' specifications."
;; `org-footnote-auto-label' is t.
(should
(string-match-p
"Test\\[fn:1\\]\n+\\[fn:1\\]"
(org-test-with-temp-text "Test<point>"
(let ((org-footnote-auto-label t)
(org-footnote-section nil))
(org-footnote-new))
(buffer-string))))
;; `org-footnote-auto-label' is `random'.
(should
(string-match-p
"Test\\[fn:\\(.+?\\)\\]\n+\\[fn:\\1\\]"
(org-test-with-temp-text "Test<point>"
(let ((org-footnote-auto-label 'random)
(org-footnote-section nil))
(org-footnote-new))
(buffer-string))))
;; Error at beginning of line.
(should-error
(org-test-with-temp-text "<point>Test"
(org-footnote-new)))
;; Error at keywords.
(should-error
(org-test-with-temp-text "#+TIT<point>LE: value"
(org-footnote-new)))
(should-error
(org-test-with-temp-text "#+CAPTION: <point>\nParagraph"
(org-footnote-new)))
;; Allow new footnotes in blank lines at the beginning of the
;; document.
(should
(string-match-p
" \\[fn:1\\]"
(org-test-with-temp-text " <point>"
(let ((org-footnote-auto-label t)) (org-footnote-new))
(buffer-string))))
;; In an headline or inlinetask, point must be either on the
;; heading itself or on the blank lines below.
(should (org-test-with-temp-text "* H<point>" (org-footnote-new) t))
(should
(org-test-with-temp-text "* H\n <point>\nParagraph" (org-footnote-new) t))
(should-error (org-test-with-temp-text "*<point> H" (org-footnote-new) t))
(should-error
(org-test-with-temp-text "* H <point>:tag:" (org-footnote-new) t))
;; Allow new footnotes within recursive objects, but not in links.
(should
(string-match-p
" \\*bold\\[fn:1\\]\\*"
(org-test-with-temp-text " *bold<point>*"
(let ((org-footnote-auto-label t)) (org-footnote-new))
(buffer-string))))
(should-error
(org-test-with-temp-text " [[https://orgmode.org][Org mode<point>]]"
(org-footnote-new)))
;; Allow new footnotes in blank lines after an element or white
;; spaces after an object.
(should
(string-match-p
" \\[fn:1\\]"
(org-test-with-temp-text "#+BEGIN_EXAMPLE\nA\n#+END_EXAMPLE\n <point>"
(let ((org-footnote-auto-label t)) (org-footnote-new))
(buffer-string))))
(should
(string-match-p
" \\*bold\\*\\[fn:1\\]"
(org-test-with-temp-text " *bold*<point>"
(let ((org-footnote-auto-label t)) (org-footnote-new))
(buffer-string))))
;; When creating a new footnote, move to its definition.
(should
(string=
"[fn:1]"
(org-test-with-temp-text "Text<point>"
(let ((org-footnote-auto-label t)
(org-footnote-auto-adjust nil))
(org-footnote-new))
(buffer-substring-no-properties (line-beginning-position) (point)))))
;; Re-order and re-label footnotes properly when
;; `org-footnote-auto-adjust' is non-nil.
(should
(string=
"[fn:1] 1\n\n[fn:2] \n\n[fn:3] 2\n"
(org-test-with-temp-text
"Text[fn:1]Text<point>Text[fn:2]\n\n[fn:1] 1\n\n[fn:2] 2"
(let ((org-footnote-auto-label t)
(org-footnote-auto-adjust t)
(org-footnote-section nil))
(org-footnote-new))
(buffer-substring-no-properties
(line-beginning-position -1)
(line-beginning-position 4)))))
;; Do not alter file local variables when inserting new definition
;; label.
(should
(equal "Paragraph[fn:1]
\[fn:1]
# Local Variables:
# foo: t
# End:"
(org-test-with-temp-text
"Paragraph<point>\n# Local Variables:\n# foo: t\n# End:"
(let ((org-footnote-section nil)) (org-footnote-new))
(buffer-string))))
(should
(equal "Paragraph[fn:1]
* Footnotes
\[fn:1]
# Local Variables:
# foo: t
# End:"
(org-test-with-temp-text
"Paragraph<point>\n# Local Variables:\n# foo: t\n# End:"
(let ((org-footnote-section "Footnotes")) (org-footnote-new))
(buffer-string)))))
(ert-deftest test-org-footnote/delete ()
"Test `org-footnote-delete' specifications."
;; Regular test.
(should
(equal "Paragraph"
(org-test-with-temp-text "Paragraph<point>[fn:1]\n\n[fn:1] Definition"
(org-footnote-delete)
(org-trim (buffer-string)))))
;; Remove multiple definitions and references.
(should
(equal "Paragraph and another"
(org-test-with-temp-text
"Paragraph<point>[fn:1] and another[fn:1]
\[fn:1] def
\[fn:1] def"
(org-footnote-delete)
(org-trim (buffer-string)))))
;; Delete inline footnotes and all references.
(should
(equal "Para and"
(org-test-with-temp-text "Para<point>[fn:label:def] and[fn:label]"
(org-footnote-delete)
(org-trim (buffer-string)))))
;; Delete anonymous footnotes.
(should
(equal "Para"
(let ((org-footnote-section nil))
(org-test-with-temp-text "Para<point>[fn::def]"
(org-footnote-delete)
(org-trim (buffer-string))))))
;; With an argument, delete footnote with specified label.
(should
(equal "Paragraph[fn:1] and another\n\n[fn:1] def"
(let ((org-footnote-section nil))
(org-test-with-temp-text
"Paragraph[fn:1] and another[fn:2]\n\n[fn:1] def\n\n[fn:2] def2"
(org-footnote-delete "2")
(org-trim (buffer-string))))))
;; Error when no argument is specified at point is not at a footnote
;; reference.
(should-error
(org-test-with-temp-text "Para[fn:1]\n\n[fn:1] Def"
(org-footnote-delete)))
;; Correctly delete footnotes with multiple paragraphs.
(should
(equal "Para\n\n\nOutside footnote."
(let ((org-footnote-section nil))
(org-test-with-temp-text
"Para[fn:1]\n\n[fn:1] para1\n\npara2\n\n\nOutside footnote."
(org-footnote-delete "1")
(org-trim (buffer-string))))))
;; Remove blank lines above the footnote but preserve those after
;; it.
(should
(equal "Text\n\n\nOther text."
(let ((org-footnote-section nil))
(org-test-with-temp-text
"Text[fn:1]\n\n[fn:1] Definition.\n\n\nOther text."
(org-footnote-delete "1")
(buffer-string)))))
;; Preserve file local variables when deleting a footnote.
(should
(equal
"Paragraph\n# Local Variables:\n# foo: t\n# End:"
(org-test-with-temp-text
"Paragraph[fn:1]\n[fn:1] Def 1\n# Local Variables:\n# foo: t\n# End:"
(let ((org-footnote-section nil)) (org-footnote-delete "1"))
(buffer-string)))))
(ert-deftest test-org-footnote/goto-definition ()
"Test `org-footnote-goto-definition' specifications."
;; Error on unknown definitions.
(should-error
(org-test-with-temp-text "No footnote definition"
(org-footnote-goto-definition "1")))
;; Error when trying to reach a definition outside narrowed part of
;; buffer.
(should-error
(org-test-with-temp-text "Some text<point>\n[fn:1] Definition."
(narrow-to-region (point-min) (point))
(org-footnote-goto-definition "1")))
(should-error
(org-test-with-temp-text "[fn:1] Definition.\n<point>Some text"
(narrow-to-region (point) (point-max))
(org-footnote-goto-definition "1")))
;; Otherwise, move at the beginning of the definition, including
;; anonymous footnotes.
(should
(equal
" Definition."
(org-test-with-temp-text "Some text\n[fn:1] Definition."
(org-footnote-goto-definition "1")
(buffer-substring (point) (point-max)))))
(should
(equal
"definition]"
(org-test-with-temp-text "Some text[fn:label:definition]"
(org-footnote-goto-definition "label")
(buffer-substring (point) (point-max))))))
(ert-deftest test-org-footnote/goto-previous-reference ()
"Test `org-footnote-goto-previous-reference' specifications."
;; Error on unknown reference.
(should-error
(org-test-with-temp-text "No footnote reference"
(org-footnote-goto-previous-reference "1")))
;; Error when trying to reach a reference outside narrowed part of
;; buffer.
(should-error
(org-test-with-temp-text "Some text<point>\nReference[fn:1]."
(narrow-to-region (point-min) (point))
(org-footnote-goto-previous-reference "1")))
;; Otherwise, move to closest reference from point.
(should
(org-test-with-temp-text "First reference[fn:1]\nReference[fn:1].<point>"
(org-footnote-goto-previous-reference "1")
(= (line-end-position) (point-max))))
(should
(org-test-with-temp-text "First reference[fn:1]\nReference[fn:1]."
(org-footnote-goto-previous-reference "1")
(= (line-beginning-position) (point-min)))))
(ert-deftest test-org-footnote/sort ()
"Test `org-footnote-sort' specifications."
;; Reorder definitions with a nil `org-footnote-section'. In this
;; case each definition is written at the end of the section
;; containing its first reference.
(should
(equal
"
Text[fn:1][fn:2]
\[fn:1] Def 1
\[fn:2] Def 2
"
(org-test-with-temp-text "
Text[fn:1][fn:2]
\[fn:2] Def 2
\[fn:1] Def 1"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
(should
(equal
"
* H1
Text[fn:1]
\[fn:1] Def 1
* H2
Text[fn:2]
\[fn:2] Def 2
"
(org-test-with-temp-text "
* H1
Text[fn:1]
* H2
Text[fn:2]
\[fn:1] Def 1
\[fn:2] Def 2
"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
;; Reorder definitions with a non-nil `org-footnote-section'.
(should
(equal
"
Text[fn:1][fn:2]
* Footnotes
\[fn:1] Def 1
\[fn:2] Def 2
"
(org-test-with-temp-text "
Text[fn:1][fn:2]
\[fn:2] Def 2
\[fn:1] Def 1"
(let ((org-footnote-section "Footnotes")) (org-footnote-sort))
(buffer-string))))
;; When `org-footnote-section' is non-nil, clear previous footnote
;; sections.
(should
(equal
"
Text[fn:1]
* Headline
* Other headline
* Footnotes
\[fn:1] Def 1
"
(org-test-with-temp-text "
Text[fn:1]
* Footnotes
\[fn:1] Def 1
* Headline
** Footnotes
* Other headline"
(let ((org-footnote-section "Footnotes")) (org-footnote-sort))
(buffer-string))))
;; Ignore anonymous footnotes.
(should
(equal
"
Text[fn:1][fn::inline][fn:2]
\[fn:1] Def 1
\[fn:2] Def 2
"
(org-test-with-temp-text
"
Text[fn:1][fn::inline][fn:2]
\[fn:2] Def 2
\[fn:1] Def 1"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
;; Ignore inline footnotes.
(should
(equal
"
Text[fn:1][fn:label:inline][fn:2]
\[fn:1] Def 1
\[fn:2] Def 2
"
(org-test-with-temp-text
"
Text[fn:1][fn:label:inline][fn:2]
\[fn:2] Def 2
\[fn:1] Def 1"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
;; Handle (deeply) nested footnotes.
(should
(equal
"
Text[fn:1][fn:3]
\[fn:1] Def 1[fn:2]
\[fn:2] Def 2
\[fn:3] Def 3
"
(org-test-with-temp-text "
Text[fn:1][fn:3]
\[fn:1] Def 1[fn:2]
\[fn:3] Def 3
\[fn:2] Def 2
"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
(should
(equal
"
Text[fn:1][fn:4]
\[fn:1] Def 1[fn:2]
\[fn:2] Def 2[fn:3]
\[fn:3] Def 3
\[fn:4] Def 4
"
(org-test-with-temp-text "
Text[fn:1][fn:4]
\[fn:1] Def 1[fn:2]
\[fn:3] Def 3
\[fn:2] Def 2[fn:3]
\[fn:4] Def 4
"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
;; When multiple (nested) references are used, make sure to insert
;; definition only once.
(should
(equal
"
* Section 1
Text[fn:1]
\[fn:1] Def 1
* Section 2
Text[fn:1]"
(org-test-with-temp-text
"
* Section 1
Text[fn:1]
\[fn:1] Def 1
* Section 2
Text[fn:1]"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
(should
(equal
"
Text[fn:1][fn:4]
\[fn:1] Def 1[fn:2][fn:3]
\[fn:2] Def 2[fn:3]
\[fn:3] Def 3
\[fn:4] Def 4
"
(org-test-with-temp-text "
Text[fn:1][fn:4]
\[fn:1] Def 1[fn:2][fn:3]
\[fn:3] Def 3
\[fn:2] Def 2[fn:3]
\[fn:4] Def 4
"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
;; Insert un-referenced definitions at the end.
(should
(equal
"Text[fn:9]
\[fn:9] B
\[fn:1] A
"
(org-test-with-temp-text "Text[fn:9]\n\n[fn:1] A\n[fn:9] B"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string))))
;; When sorting, preserve file local variables.
(should
(equal "
Paragraph[fn:1][fn:2]
\[fn:1] Def 1
\[fn:2] Def 2
# Local Variables:
# foo: t
# End:"
(org-test-with-temp-text
"
Paragraph[fn:1][fn:2]
\[fn:2] Def 2
\[fn:1] Def 1
# Local Variables:
# foo: t
# End:"
(let ((org-footnote-section nil)) (org-footnote-sort))
(buffer-string)))))
(ert-deftest test-org-footnote/renumber-fn:N ()
"Test `org-footnote-renumber-fn:N' specifications."
;; Renumber (inline) references and definitions.
(should
(equal
"Test[fn:1]"
(org-test-with-temp-text "Test[fn:99]"
(org-footnote-renumber-fn:N)
(buffer-string))))
(should
(equal
"Test[fn:1]\n\n[fn:1] 99"
(org-test-with-temp-text "Test[fn:99]\n\n[fn:99] 99"
(org-footnote-renumber-fn:N)
(buffer-string))))
(should
(equal
"Test[fn:1:99]"
(org-test-with-temp-text "Test[fn:99:99]"
(org-footnote-renumber-fn:N)
(buffer-string))))
;; No-op if there's no numbered footnote.
(should
(equal
"Test[fn:label]\n\n[fn:label] Def"
(org-test-with-temp-text "Test[fn:label]\n\n[fn:label] Def"
(org-footnote-renumber-fn:N)
(buffer-string))))
;; Definitions without a reference get the highest numbers.
(should
(equal
"Test[fn:1]\n[fn:1] 1\n[fn:2] 99"
(org-test-with-temp-text "Test[fn:1]\n[fn:1] 1\n[fn:99] 99"
(org-footnote-renumber-fn:N)
(buffer-string))))
;; Sort labels in sequence. Anonymous footnotes are ignored.
(should
(equal
"Test[fn:1][fn:2:def][fn:3]"
(org-test-with-temp-text "Test[fn:4][fn:3:def][fn:2]"
(org-footnote-renumber-fn:N)
(buffer-string))))
(should
(equal
"Test[fn:1][fn::def][fn:2]"
(org-test-with-temp-text "Test[fn:4][fn::def][fn:2]"
(org-footnote-renumber-fn:N)
(buffer-string)))))
(ert-deftest test-org-footnote/normalize ()
"Test `org-footnote-normalize' specifications."
;; Normalize regular, inline and anonymous references.
(should
(equal
"Test[fn:1]\n\n[fn:1] def\n"
(org-test-with-temp-text "Test[fn:label]\n[fn:label] def"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
(should
(equal
"Test[fn:1]\n\n[fn:1] def\n"
(org-test-with-temp-text "Test[fn:label:def]"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
(should
(equal
"Test[fn:1]\n\n[fn:1] def\n"
(org-test-with-temp-text "Test[fn::def]"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
;; Normalization includes sorting.
(should
(equal
"Test[fn:1][fn:2]\n\n[fn:1] def2\n\n[fn:2] def\n"
(org-test-with-temp-text "Test[fn:2][fn:1]\n\n[fn:2] def2\n[fn:1] def"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
(should
(equal
"Test[fn:1][fn:2]\n\n[fn:1] def\n\n[fn:2] inline\n"
(org-test-with-temp-text "Test[fn:2][fn::inline]\n[fn:2] def\n"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
(should
(equal
"Test[fn:1][fn:3]
\[fn:1] def[fn:2]
\[fn:2] inline
\[fn:3] last
"
(org-test-with-temp-text
"Test[fn:lab1][fn:lab2]\n[fn:lab1] def[fn::inline]\n[fn:lab2] last"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
;; When normalizing an inline reference, fill paragraph whenever the
;; `org-footnote-fill-after-inline-note-extraction' is non-nil.
(should
(equal
"Test[fn:1] Next\n\n[fn:1] def\n"
(org-test-with-temp-text "Test[fn::def]\nNext"
(let ((org-footnote-section nil)
(org-footnote-fill-after-inline-note-extraction t))
(org-footnote-normalize))
(buffer-string))))
;; Insert un-referenced definitions at the end.
(should
(equal
"Test[fn:1]\nNext\n\n[fn:1] def\n\n[fn:2] A\n"
(org-test-with-temp-text "Test[fn::def]\nNext\n[fn:unref] A"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string))))
;; Preserve file local variables when normalizing.
(should
(equal "
Paragraph[fn:1][fn:2]
\[fn:1] Def 1
\[fn:2] Def 2
# Local Variables:
# foo: t
# End:"
(org-test-with-temp-text
"
Paragraph[fn:foo][fn:bar]
\[fn:bar] Def 2
\[fn:foo] Def 1
# Local Variables:
# foo: t
# End:"
(let ((org-footnote-section nil)) (org-footnote-normalize))
(buffer-string)))))
(provide 'test-org-footnote)
;;; test-org-footnote.el ends here

64
lisp/org/testing/lisp/test-org-info.el Normal file
View File

@@ -0,0 +1,64 @@
;;; test-org-info.el --- Tests for "org-info.el" -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-org-info/export ()
"Test `org-info-export' specifications."
;; Export to HTML. Without node, refer to "Top".
(should
(equal (org-info-export "filename#node" nil 'html)
"<a href=\"filename.html#node\">filename#node</a>"))
(should
(equal (org-info-export "filename" nil 'html)
"<a href=\"filename.html#Top\">filename</a>"))
;; When exporting to HTML, ensure node names are expanded according
;; to (info "(texinfo) HTML Xref Node Name Expansion").
(should
(equal "_005f"
(let ((name (org-info-export "#_" nil 'html)))
(and (string-match "#\\(.*\\)\"" name)
(match-string 1 name)))))
(should
(equal "_002d"
(let ((name (org-info-export "#-" nil 'html)))
(and (string-match "#\\(.*\\)\"" name)
(match-string 1 name)))))
(should
(equal "A-node"
(let ((name (org-info-export "#A node" nil 'html)))
(and (string-match "#\\(.*\\)\"" name)
(match-string 1 name)))))
(should
(equal "A-node-_002d_002d_002d-with-_005f_0027_0025"
(let ((name (org-info-export "#A node --- with _'%" nil 'html)))
(and (string-match "#\\(.*\\)\"" name)
(match-string 1 name)))))
;; Export to Texinfo. Without a node name, refer to "Top".
(should
(equal (org-info-export "filename" nil 'texinfo)
"@ref{Top,,,filename,}"))
(should
(equal (org-info-export "filename#node" nil 'texinfo)
"@ref{node,,,filename,}")))
(provide 'test-org-info)
;;; test-org-info.el ends here

163
lisp/org/testing/lisp/test-org-inlinetask.el Normal file
View File

@@ -0,0 +1,163 @@
;;; test-org-inlinetask.el --- Tests for org-inlinetask.el
;; Copyright (c) Marco Wahl
;; Authors: Marco Wahl
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;; Tests for org-inlinetask.el.
;;; Code:
(require 'org-inlinetask)
;;; Test movement
(ert-deftest test-org-inlinetask/org-inlinetask-goto-end ()
;; Goto end.
(should
(equal
(let ((org-inlinetask-min-level 5)
(org-adapt-indentation t))
(org-test-with-temp-text
"** H
<point>***** I
***** END
foo"
(org-inlinetask-goto-end)
(insert "<point>")
(buffer-string)))
"** H
***** I
***** END
<point>foo"))
;; Goto end. End is buffer end.
(should
(equal
(let ((org-inlinetask-min-level 5)
(org-adapt-indentation t))
(org-test-with-temp-text
"** H
<point>***** I
***** END"
(org-inlinetask-goto-end)
(insert "<point>")
(buffer-string)))
"** H
***** I
***** END<point>"))
;; Goto end. Starting somewhere.
(should
(equal
(let ((org-inlinetask-min-level 5)
(org-adapt-indentation t))
(org-test-with-temp-text
"** H
****<point>* I
***** END
***** I
***** END"
(org-inlinetask-goto-end)
(insert "<point>")
(buffer-string)))
"** H
***** I
***** END
<point>***** I
***** END"))
(should
(equal
(let ((org-inlinetask-min-level 5)
(org-adapt-indentation t))
(org-test-with-temp-text
"** H
***** I
<point> inside
***** END
***** I
***** END"
(org-inlinetask-goto-end)
(insert "<point>")
(buffer-string)))
"** H
***** I
inside
***** END
<point>***** I
***** END")))
(ert-deftest test-org-inlinetask/inlinetask-within-plain-list ()
"Fold inlinetasks in plain-lists.
Report:
http://lists.gnu.org/archive/html/emacs-orgmode/2017-12/msg00502.html"
(should
(org-test-with-temp-text
"* Test
<point>- x
- a
*************** List folding stopped here
*************** END
- b
"
(org-cycle-internal-local)
(invisible-p (1- (search-forward "- b"))))))
(ert-deftest test-org-inlinetask/folding-directly-consecutive-tasks/0 ()
"Fold directly consecutive inlinetasks."
(should
(org-test-with-temp-text
"* Test
<point>- x
- a
*************** List folding stopped here
*************** END
*************** List folding stopped here
*************** END
- b
"
(org-cycle-internal-local)
(invisible-p (1- (search-forward "- b"))))))
(ert-deftest test-org-inlinetask/folding-directly-consecutive-tasks/1 ()
"Fold directly consecutive inlinetasks."
(should
(org-test-with-temp-text
"<point>* Test
*************** p1
p2
*************** END
*************** p3
p4
*************** END
"
(org-flag-subtree t)
(org-cycle)
(and
(not (invisible-p (1- (search-forward "p1"))))
(invisible-p (1- (search-forward "p2")))
(not (invisible-p (1- (search-forward "p3"))))
(invisible-p (1- (search-forward "p4")))))))
(provide 'test-org-inlinetask)
;;; test-org-inlinetask.el ends here

534
lisp/org/testing/lisp/test-org-lint.el Normal file
View File

@@ -0,0 +1,534 @@
;;; test-org-lint.el --- Tests for Org Lint -*- lexical-binding: t; -*-
;; Copyright (C) 2016, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest test-org-lint/duplicate-custom-id ()
"Test `org-lint-duplicate-custom-id' checker."
(should
(org-test-with-temp-text "
* H1
:PROPERTIES:
:CUSTOM_ID: foo
:END:
* H2
:PROPERTIES:
:CUSTOM_ID: foo
:END:"
(org-lint '(duplicate-custom-id))))
(should-not
(org-test-with-temp-text "
* H1
:PROPERTIES:
:CUSTOM_ID: foo
:END:
* H2
:PROPERTIES:
:CUSTOM_ID: bar
:END:"
(org-lint '(duplicate-custom-id)))))
(ert-deftest test-org-lint/duplicate-name ()
"Test `org-lint-duplicate-name' checker."
(should
(org-test-with-temp-text "
#+name: foo
Paragraph1
#+name: foo
Paragraph 2"
(org-lint '(duplicate-name))))
(should-not
(org-test-with-temp-text "
#+name: foo
Paragraph1
#+name: bar
Paragraph 2"
(org-lint '(duplicate-name)))))
(ert-deftest test-org-lint/duplicate-target ()
"Test `org-lint-duplicate-target' checker."
(should
(org-test-with-temp-text "<<foo>> <<foo>>"
(org-lint '(duplicate-target))))
(should-not
(org-test-with-temp-text "<<foo>> <<bar>>"
(org-lint '(duplicate-target)))))
(ert-deftest test-org-lint/duplicate-footnote-definition ()
"Test `org-lint-duplicate-footnote-definition' checker."
(should
(org-test-with-temp-text "
\[fn:1] Definition 1
\[fn:1] Definition 2"
(org-lint '(duplicate-footnote-definition))))
(should-not
(org-test-with-temp-text "
\[fn:1] Definition 1
\[fn:2] Definition 2"
(org-lint '(duplicate-footnote-definition)))))
(ert-deftest test-org-lint/orphaned-affiliated-keywords ()
"Test `org-lint-orphaned-affiliated-keywords' checker."
(should
(org-test-with-temp-text "#+name: foo"
(org-lint '(orphaned-affiliated-keywords)))))
(ert-deftest test-org-lint/deprecated-export-blocks ()
"Test `org-lint-deprecated-export-blocks' checker."
(should
(org-test-with-temp-text "
#+begin_latex
...
#+end_latex"
(org-lint '(deprecated-export-blocks)))))
(ert-deftest test-org-lint/deprecated-header-syntax ()
"Test `org-lint-deprecated-header-syntax' checker."
(should
(org-test-with-temp-text "#+property: cache yes"
(org-lint '(deprecated-header-syntax))))
(should
(org-test-with-temp-text "
* H
:PROPERTIES:
:cache: yes
:END:"
(org-lint '(deprecated-header-syntax)))))
(ert-deftest test-org-lint/missing-language-in-src-block ()
"Test `org-lint-missing-language-in-src-block' checker."
(should
(org-test-with-temp-text "
#+begin_src
...
#+end_src"
(org-lint '(missing-language-in-src-block)))))
(ert-deftest test-org-lint/missing-backend-in-export-block ()
"Test `org-lint-missing-backend-in-export-block' checker."
(should
(org-test-with-temp-text "
#+begin_export
...
#+end_export"
(org-lint '(missing-backend-in-export-block)))))
(ert-deftest test-org-lint/invalid-babel-call-block ()
"Test `org-lint-invalid-babel-call-block' checker."
(should
(org-test-with-temp-text "#+call:"
(org-lint '(invalid-babel-call-block))))
(should
(org-test-with-temp-text "#+call: foo() [:exports code]"
(org-lint '(invalid-babel-call-block)))))
(ert-deftest test-org-lint/deprecated-category-setup ()
"Test `org-lint-deprecated-category-setup' checker."
(should
(org-test-with-temp-text "#+category: foo\n#+category: bar"
(org-lint '(deprecated-category-setup)))))
(ert-deftest test-org-lint/invalid-coderef-link ()
"Test `org-lint-invalid-coderef-link' checker."
(should
(org-test-with-temp-text "[[(unknown)]]"
(org-lint '(invalid-coderef-link))))
(should-not
(org-test-with-temp-text "[[(foo)]]
#+begin_src emacs-lisp -l \"; ref:%s\"
(+ 1 1) ; ref:foo
#+end_src"
(org-lint '(invalid-coderef-link)))))
(ert-deftest test-org-lint/invalid-custom-id-link ()
"Test `org-lint-invalid-custom-id-link' checker."
(should
(org-test-with-temp-text "[[#unknown]]"
(org-lint '(invalid-custom-id-link))))
(should-not
(org-test-with-temp-text "[[#foo]]
* H
:PROPERTIES:
:CUSTOM_ID: foo
:END:"
(org-lint '(invalid-custom-id-link)))))
(ert-deftest test-org-lint/invalid-fuzzy-link ()
"Test `org-lint-invalid-fuzzy-link' checker."
(should
(org-test-with-temp-text "[[*unknown]]"
(org-lint '(invalid-fuzzy-link))))
(should-not
(org-test-with-temp-text "[[*foo]]\n* foo"
(org-lint '(invalid-fuzzy-link))))
(should
(org-test-with-temp-text "[[unknown]]"
(org-lint '(invalid-fuzzy-link))))
(should-not
(org-test-with-temp-text "[[foo]]\n#+name: foo\nParagraph"
(org-lint '(invalid-fuzzy-link))))
(should-not
(org-test-with-temp-text "[[foo]]\n<<foo>>"
(org-lint '(invalid-fuzzy-link)))))
(ert-deftest test-org-lint/special-property-in-properties-drawer ()
"Test `org-lint-special-property-in-properties-drawer' checker."
(should
(org-test-with-temp-text "
* H
:PROPERTIES:
:TODO: foo
:END:"
(org-lint '(special-property-in-properties-drawer)))))
(ert-deftest test-org-lint/obsolete-properties-drawer ()
"Test `org-lint-obsolete-properties-drawer' checker."
(should
(org-test-with-temp-text "
* H
Paragraph
:PROPERTIES:
:SOMETHING: foo
:END:"
(org-lint '(obsolete-properties-drawer))))
(should
(org-test-with-temp-text "
* H
:PROPERTIES:
This is not a node property
:END:"
(org-lint '(obsolete-properties-drawer)))))
(ert-deftest test-org-lint/invalid-effort-property ()
"Test `org-lint-invalid-effort-property' checker."
(should
(org-test-with-temp-text "* H\n:PROPERTIES:\n:EFFORT: something\n:END:"
(org-lint '(invalid-effort-property))))
(should-not
(org-test-with-temp-text "* H\n:PROPERTIES:\n:EFFORT: 1:23\n:END:"
(org-lint '(invalid-effort-property)))))
(ert-deftest test-org-lint/link-to-local-file ()
"Test `org-lint-link-to-local-file' checker."
(should
(org-test-with-temp-text "[[file:/Idonotexist.org]]"
(org-lint '(link-to-local-file)))))
(ert-deftest test-org-lint/non-existent-setupfile-parameter ()
"Test `org-lint-non-existent-setupfile-parameter' checker."
(should
(org-test-with-temp-text "#+setupfile: Idonotexist.org"
(org-lint '(non-existent-setupfile-parameter))))
(should-not
(org-test-with-temp-text "#+setupfile: https://I.do/not.exist.org"
(org-lint '(non-existent-setupfile-parameter)))))
(ert-deftest test-org-lint/wrong-include-link-parameter ()
"Test `org-lint-wrong-include-link-parameter' checker."
(should
(org-test-with-temp-text "#+include:"
(org-lint '(wrong-include-link-parameter))))
(should
(org-test-with-temp-text "#+include: Idonotexist.org"
(org-lint '(wrong-include-link-parameter))))
(should
(org-test-with-temp-text-in-file ""
(let ((file (buffer-file-name)))
(org-test-with-temp-text (format "#+include: \"%s::#foo\"" file)
(org-lint '(wrong-include-link-parameter))))))
(should-not
(org-test-with-temp-text-in-file "* foo"
(let ((file (buffer-file-name)))
(org-test-with-temp-text (format "#+include: \"%s::*foo\"" file)
(org-lint '(wrong-include-link-parameter)))))))
(ert-deftest test-org-lint/obsolete-include-markup ()
"Test `org-lint-obsolete-include-markup' checker."
(should
(org-test-with-temp-text-in-file ""
(let ((file (buffer-file-name)))
(org-test-with-temp-text (format "#+include: \"%s\" html" file)
(org-lint '(obsolete-include-markup))))))
(should-not
(org-test-with-temp-text-in-file ""
(let ((file (buffer-file-name)))
(org-test-with-temp-text (format "#+include: \"%s\" export html" file)
(org-lint '(obsolete-include-markup)))))))
(ert-deftest test-org-lint/unknown-options-item ()
"Test `org-lint-unknown-options-item' checker."
(should
(org-test-with-temp-text "#+options: foobarbaz:t"
(org-lint '(unknown-options-item)))))
(ert-deftest test-org-lint/invalid-macro-argument-and-template ()
"Test `org-lint-invalid-macro-argument-and-template' checker."
(should
(org-test-with-temp-text "{{{undefined()}}}"
(org-lint '(invalid-macro-argument-and-template))))
(should
(org-test-with-temp-text
"#+macro: wrongsignature $1 $2\n{{{wrongsignature(1, 2, 3)}}}"
(org-lint '(invalid-macro-argument-and-template))))
(should
(org-test-with-temp-text "#+macro:"
(org-lint '(invalid-macro-argument-and-template))))
(should
(org-test-with-temp-text "#+macro: missingtemplate"
(org-lint '(invalid-macro-argument-and-template))))
(should
(org-test-with-temp-text "#+macro: unusedplaceholders $1 $3"
(org-lint '(invalid-macro-argument-and-template))))
(should-not
(org-test-with-temp-text
"#+macro: valid $1 $2\n{{{valid(1, 2)}}}"
(org-lint '(invalid-macro-argument-and-template)))))
(ert-deftest test-org-lint/undefined-footnote-reference ()
"Test `org-lint-undefined-footnote-reference' checker."
(should
(org-test-with-temp-text "Text[fn:1]"
(org-lint '(undefined-footnote-reference))))
(should-not
(org-test-with-temp-text "Text[fn:1]\n[fn:1] Definition"
(org-lint '(undefined-footnote-reference))))
(should-not
(org-test-with-temp-text "Text[fn:1:inline reference]"
(org-lint '(undefined-footnote-reference))))
(should-not
(org-test-with-temp-text "Text[fn::anonymous reference]"
(org-lint '(undefined-footnote-reference)))))
(ert-deftest test-org-lint/unreferenced-footnote-definition ()
"Test `org-lint-unreferenced-footnote-definition' checker."
(should
(org-test-with-temp-text "[fn:1] Definition"
(org-lint '(unreferenced-footnote-definition))))
(should-not
(org-test-with-temp-text "Text[fn:1]\n[fn:1] Definition"
(org-lint '(unreferenced-footnote-definition)))))
(ert-deftest test-org-lint/colon-in-name ()
"Test `org-lint-colon-in-name' checker."
(should
(org-test-with-temp-text "#+name: tab:name\n| a |"
(org-lint '(colon-in-name))))
(should-not
(org-test-with-temp-text "#+name: name\n| a |"
(org-lint '(colon-in-name)))))
(ert-deftest test-org-lint/misplaced-planning-info ()
"Test `org-lint-misplaced-planning-info' checker."
(should
(org-test-with-temp-text "SCHEDULED: <2012-03-29 thu.>"
(org-lint '(misplaced-planning-info))))
(should
(org-test-with-temp-text "
* H
Text
SCHEDULED: <2012-03-29 thu.>"
(org-lint '(misplaced-planning-info))))
(should-not
(org-test-with-temp-text "
* H
SCHEDULED: <2012-03-29 thu.>"
(org-lint '(misplaced-planning-info)))))
(ert-deftest test-org-lint/incomplete-drawer ()
"Test `org-lint-incomplete-drawer' checker."
(should
(org-test-with-temp-text ":DRAWER:"
(org-lint '(incomplete-drawer))))
(should-not
(org-test-with-temp-text ":DRAWER:\n:END:"
(org-lint '(incomplete-drawer)))))
(ert-deftest test-org-lint/indented-diary-sexp ()
"Test `org-lint-indented-diary-sexp' checker."
(should
(org-test-with-temp-text " %%(foo)"
(org-lint '(indented-diary-sexp))))
(should-not
(org-test-with-temp-text "%%(foo)"
(org-lint '(indented-diary-sexp)))))
(ert-deftest test-org-lint/invalid-block ()
"Test `org-lint-invalid-block' checker."
(should
(org-test-with-temp-text "#+begin_foo"
(org-lint '(invalid-block))))
(should-not
(org-test-with-temp-text "#+begin_foo\n#+end_foo"
(org-lint '(invalid-block)))))
(ert-deftest test-org-lint/invalid-keyword-syntax ()
"Test `org-lint-invalid-keyword-syntax' checker."
(should
(org-test-with-temp-text "#+keyword"
(org-lint '(invalid-keyword-syntax))))
(should-not
(org-test-with-temp-text "#+keyword:"
(org-lint '(invalid-keyword-syntax)))))
(ert-deftest test-org-lint/extraneous-element-in-footnote-section ()
"Test `org-lint-extraneous-element-in-footnote-section' checker."
(should
(org-test-with-temp-text "* Footnotes\nI'm not a footnote definition"
(let ((org-footnote-section "Footnotes"))
(org-lint '(extraneous-element-in-footnote-section)))))
(should-not
(org-test-with-temp-text "* Footnotes\n[fn:1] I'm a footnote definition"
(let ((org-footnote-section "Footnotes"))
(org-lint '(extraneous-element-in-footnote-section))))))
(ert-deftest test-org-lint/quote-section ()
"Test `org-lint-quote-section' checker."
(should
(org-test-with-temp-text "* QUOTE H"
(org-lint '(quote-section))))
(should
(org-test-with-temp-text "* COMMENT QUOTE H"
(org-lint '(quote-section)))))
(ert-deftest test-org-lint/file-application ()
"Test `org-lint-file-application' checker."
(should
(org-test-with-temp-text "[[file+emacs:foo.org]]"
(org-lint '(file-application)))))
(ert-deftest test-org-lint/percenc-encoding-link-escape ()
"Test `org-lint-percent-encoding-link-escape' checker."
(should
(org-test-with-temp-text "[[A%20B]]"
(org-lint '(percent-encoding-link-escape))))
(should
(org-test-with-temp-text "[[%5Bfoo%5D]]"
(org-lint '(percent-encoding-link-escape))))
(should
(org-test-with-temp-text "[[A%2520B]]"
(org-lint '(percent-encoding-link-escape))))
(should-not
(org-test-with-temp-text "[[A B]]"
(org-lint '(percent-encoding-link-escape))))
(should-not
(org-test-with-temp-text "[[A%30B]]"
(org-lint '(percent-encoding-link-escape))))
(should-not
(org-test-with-temp-text "[[A%20%30B]]"
(org-lint '(percent-encoding-link-escape))))
(should-not
(org-test-with-temp-text "<file:A%20B>"
(org-lint '(percent-encoding-link-escape))))
(should-not
(org-test-with-temp-text "[[A B%]]"
(org-lint '(percent-encoding-link-escape)))))
(ert-deftest test-org-lint/wrong-header-argument ()
"Test `org-lint-wrong-header-argument' checker."
(should
(org-test-with-temp-text "#+call: foo() barbaz yes"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "#+call: foo() :barbaz yes"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "call_foo[barbaz yes]()"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "call_foo[:barbaz yes]()"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "#+property: header-args barbaz yes"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "#+property: header-args :barbaz yes"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "
* H
:PROPERTIES:
:HEADER-ARGS: barbaz yes
:END:"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "
* H
:PROPERTIES:
:HEADER-ARGS: :barbaz yes
:END:"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "
#+header: :barbaz yes
#+begin_src emacs-lisp
\(+ 1 1)
#+end_src"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "src_emacs-lisp[barbaz yes]{}"
(org-lint '(wrong-header-argument))))
(should
(org-test-with-temp-text "src_emacs-lisp[:barbaz yes]{}"
(org-lint '(wrong-header-argument)))))
(ert-deftest test-org-lint/wrong-header-value ()
"Test `org-lint-wrong-header-value' checker."
(should
(org-test-with-temp-text "
#+header: :cache maybe
#+begin_src emacs-lisp
\(+ 1 1)
#+end_src"
(org-lint '(wrong-header-value))))
(should
(org-test-with-temp-text "
#+header: :exports both none
#+begin_src emacs-lisp
\(+ 1 1)
#+end_src"
(org-lint '(wrong-header-value))))
(should-not
(org-test-with-temp-text "
#+header: :cache yes
#+begin_src emacs-lisp
\(+ 1 1)
#+end_src"
(org-lint '(wrong-header-value)))))
(ert-deftest test-org/spurious-colons ()
"Test `org-list-spurious-colons' checker."
(should-not
(org-test-with-temp-text "* H :tag:tag2:"
(org-lint '(spurious-colons))))
(should
(org-test-with-temp-text "* H :tag::tag2:"
(org-lint '(spurious-colons))))
(should
(org-test-with-temp-text "* H :tag::"
(org-lint '(spurious-colons)))))
(provide 'test-org-lint)
;;; test-org-lint.el ends here

1402
lisp/org/testing/lisp/test-org-list.el Normal file
View File

File diff suppressed because it is too large Load Diff

333
lisp/org/testing/lisp/test-org-macro.el Normal file
View File

@@ -0,0 +1,333 @@
;;; test-org-macro.el --- Tests for org-macro.el
;; Copyright (C) 2013, 2014, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
;;; Macros
(ert-deftest test-org/macro-replace-all ()
"Test `org-macro-replace-all' specifications."
;; Standard test.
(should
(equal
"#+MACRO: A B\n1 B 3"
(org-test-with-temp-text "#+MACRO: A B\n1 {{{A}}} 3"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-string))))
;; Macro with arguments.
(should
(equal
"#+MACRO: macro $1 $2\nsome text"
(org-test-with-temp-text "#+MACRO: macro $1 $2\n{{{macro(some,text)}}}"
(progn (org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-string)))))
;; Macro with "eval".
(should
(equal
"3"
(org-test-with-temp-text
"#+MACRO: add (eval (+ (string-to-number $1) (string-to-number $2)))
<point>{{{add(1,2)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties (point) (line-end-position)))))
;; Nested macros.
(should
(equal
"#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\ninner outer"
(org-test-with-temp-text
"#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\n{{{out}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-string))))
;; Error out when macro expansion is circular.
(should-error
(org-test-with-temp-text
"#+MACRO: mac1 {{{mac2}}}\n#+MACRO: mac2 {{{mac1}}}\n{{{mac1}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)))
;; Macros in setup file.
(should
(string-match
"success success\\'"
(org-test-with-temp-text
(format "#+MACRO: other-macro success
#+SETUPFILE: \"%sexamples/macro-templates.org\"
{{{included-macro}}} {{{other-macro}}}"
org-test-dir)
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-string))))
;; Macro expansion ignores narrowing.
(should
(string-match
"expansion"
(org-test-with-temp-text
"#+MACRO: macro expansion\n{{{macro}}}\n<point>Contents"
(narrow-to-region (point) (point-max))
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(org-with-wide-buffer (buffer-string)))))
;; Macros in a commented tree are not expanded.
(should
(string-match-p
"{{{macro}}}"
(org-test-with-temp-text
"#+MACRO: macro expansion\n* COMMENT H\n<point>{{{macro}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(org-with-wide-buffer (buffer-string)))))
(should
(string-match-p
"{{{macro}}}"
(org-test-with-temp-text
"#+MACRO: macro expansion\n* COMMENT H1\n** H2\n<point>{{{macro}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(org-with-wide-buffer (buffer-string))))))
(ert-deftest test-org-macro/property ()
"Test {{{property}}} macro."
;; With only one argument, retrieve property from current headline.
;; Otherwise, the second argument is a search option to get the
;; property from another headline.
(should
(equal "1"
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:A: 1\n:END:\n{{{property(A)}}}<point>"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(should
(equal "1"
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:A: 1\n:END:\n{{{property(A,)}}}<point>"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(should
(equal
"1"
(org-test-with-temp-text
"* H1\n:PROPERTIES:\n:A: 1\n:END:\n* H2\n{{{property(A,*H1)}}}<point>"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(should-error
(org-test-with-temp-text
"* H1\n:PROPERTIES:\n:A: 1\n:END:\n* H2\n{{{property(A,*???)}}}<point>"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates))))
(ert-deftest test-org-macro/n ()
"Test {{{n}}} macro."
;; Standard test with default counter.
(should
(equal "1 2"
(org-test-with-temp-text "{{{n}}} {{{n}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(should
(equal "1 2"
(org-test-with-temp-text "{{{n()}}} {{{n}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Test alternative counters.
(should
(equal "1 1 1 2"
(org-test-with-temp-text "{{{n}}} {{{n(c1)}}} {{{n(c2)}}} {{{n(c1)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Second argument set a counter to a given value. A non-numeric
;; value resets the counter to 1.
(should
(equal "9 10"
(org-test-with-temp-text "{{{n(c,9)}}} {{{n(c)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
(should
(equal "9 1"
(org-test-with-temp-text "{{{n(c,9)}}} {{{n(c,reset)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Check that reset happens when the second argument is neither "-"
;; nor a number.
(should
(equal "9 1 1 1"
(org-test-with-temp-text
(concat "{{{n(c,9)}}} {{{n(c,reiniciar)}}}"
" {{{n(c,réinitialiser)}}} {{{n(c,zurückstellen)}}}")
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Tolerate spaces in first argument.
(should
(equal "1 2 3 4"
(org-test-with-temp-text "{{{n(c)}}} {{{n(c )}}} {{{n( c)}}} {{{n( c )}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Tolerate spaces when second argument is an integer.
(should
(equal "2 3 5 7"
(org-test-with-temp-text
(concat "{{{n(c,2)}}} {{{n(c, 3)}}}"
" {{{n(c,5 )}}} {{{n(c, 7 )}}}")
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Tolerate spaces when second argument is the hold argument.
(should
(equal "7 7 8 8 9 9"
(org-test-with-temp-text
(concat "{{{n(,7)}}} {{{n(, -)}}}"
" {{{n}}} {{{n(,- )}}} {{{n}}} {{{n(, - )}}}")
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Tolerate spaces when second argument is used to reset the counter.
(should
(equal "9 1 1 1 1"
(org-test-with-temp-text
(concat "{{{n(c,9)}}} {{{n(c,reset)}}} {{{n(c, reset)}}}"
" {{{n(c,reset )}}} {{{n(c, reset )}}}")
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Second argument also applies to default counter.
(should
(equal "9 10 1"
(org-test-with-temp-text "{{{n(,9)}}} {{{n}}} {{{n(,reset)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; An empty second argument is equivalent to no argument.
(should
(equal "2 3"
(org-test-with-temp-text "{{{n(c,2)}}} {{{n(c,)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Hold value at reset value of 1 if the counter hasn't yet started.
(should
(equal "1"
(org-test-with-temp-text "{{{n(,-)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Increment counter following a hold.
(should
(equal "1 1 2"
(org-test-with-temp-text "{{{n}}} {{{n(,-)}}} {{{n}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Hold counter value following a counter value set.
(should
(equal "1 10 10"
(org-test-with-temp-text "{{{n}}} {{{n(,10)}}} {{{n(,-)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Hold counter value in a multiple-counter situation.
(should
(equal "1.1 1.2 1.3"
(org-test-with-temp-text
"{{{n}}}.{{{n(c)}}} {{{n(,-)}}}.{{{n(c)}}} {{{n(,-)}}}.{{{n(c)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position)))))
;; Hold counter values on one or multiple counters at the same time.
(should
(equal "1.1 1.2 2.2 2.2"
(org-test-with-temp-text
(concat "{{{n}}}.{{{n(c)}}} {{{n(,-)}}}.{{{n(c)}}}"
" {{{n}}}.{{{n(c,-)}}} {{{n(,-)}}}.{{{n(c,-)}}}")
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (line-end-position))))))
(ert-deftest test-org-macro/keyword ()
"Test {{{keyword}}} macro."
;; Replace macro with keyword's value.
(should
(equal
"value"
(org-test-with-temp-text
"#+keyword: value\n<point>{{{keyword(KEYWORD)}}}"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)
(buffer-substring-no-properties
(line-beginning-position) (point-max))))))
(ert-deftest test-org-macro/escape-arguments ()
"Test `org-macro-escape-arguments' specifications."
;; Regular tests.
(should (equal "a" (org-macro-escape-arguments "a")))
(should (equal "a,b" (org-macro-escape-arguments "a" "b")))
;; Handle empty arguments.
(should (equal "a,,b" (org-macro-escape-arguments "a" "" "b")))
;; Properly escape commas and backslashes preceding them.
(should (equal "a\\,b" (org-macro-escape-arguments "a,b")))
(should (equal "a\\\\,b" (org-macro-escape-arguments "a\\" "b")))
(should (equal "a\\\\\\,b" (org-macro-escape-arguments "a\\,b"))))
(ert-deftest test-org-macro/extract-arguments ()
"Test `org-macro-extract-arguments' specifications."
;; Regular tests.
(should (equal '("a") (org-macro-extract-arguments "a")))
(should (equal '("a" "b") (org-macro-extract-arguments "a,b")))
;; Handle empty arguments.
(should (equal '("a" "" "b") (org-macro-extract-arguments "a,,b")))
;; Handle escaped commas and backslashes.
(should (equal '("a,b") (org-macro-extract-arguments "a\\,b")))
(should (equal '("a\\" "b") (org-macro-extract-arguments "a\\\\,b")))
(should (equal '("a\\,b") (org-macro-extract-arguments "a\\\\\\,b"))))
(provide 'test-org-macro)
;;; test-org-macro.el ends here

107
lisp/org/testing/lisp/test-org-macs.el Normal file
View File

@@ -0,0 +1,107 @@
;;; test-org-macs.el --- Tests for Org Macs library -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
;;; String manipulation
(ert-deftest test-org/split-string ()
"Test `org-split-string' specifications."
;; Regular test.
(should (equal '("a" "b") (org-split-string "a b" " ")))
;; Empty parts are not removed.
(should (equal '("a" "" "b") (org-split-string "a||b" "|")))
;; However, empty parts at beginning or end of string are removed.
(should (equal '("a" "b") (org-split-string "|a|b|" "|")))
;; Pathological case: call on an empty string. Since empty parts
;; are not removed, it shouldn't return nil.
(should (equal '("") (org-split-string "")))
;; SEPARATORS, when non-nil, is a regexp. In particular, do not
;; match more than specified.
(should-not (equal '("a" "b") (org-split-string "a b" " ")))
;; When nil, SEPARATORS matches any number of blank characters.
(should (equal '("a" "b") (org-split-string "a \t\nb"))))
(ert-deftest test-org/string-width ()
"Test `org-string-width' specifications."
(should (= 1 (org-string-width "a")))
(should (= 0 (org-string-width "")))
;; Ignore invisible characters.
(should (= 0 (org-string-width #("a" 0 1 (invisible t)))))
(should (= 1 (org-string-width #("ab" 0 1 (invisible t)))))
(should (= 1 (org-string-width #("ab" 1 2 (invisible t)))))
(should (= 3 (org-string-width
#("abcde" 1 2 (invisible t) 3 4 (invisible t)))))
;; Check if `invisible' value really means invisibility.
(should (= 0 (let ((buffer-invisibility-spec t))
(org-string-width #("a" 0 1 (invisible foo))))))
(should (= 0 (let ((buffer-invisibility-spec '(foo)))
(org-string-width #("a" 0 1 (invisible foo))))))
(should (= 0 (let ((buffer-invisibility-spec '((foo . t))))
(org-string-width #("a" 0 1 (invisible foo))))))
(should (= 1 (let ((buffer-invisibility-spec '(bar)))
(org-string-width #("a" 0 1 (invisible foo))))))
;; Check `display' property.
(should (= 3 (org-string-width #("a" 0 1 (display "abc")))))
(should (= 5 (org-string-width #("1a3" 1 2 (display "abc")))))
;; `display' string can also contain invisible characters.
(should (= 4 (org-string-width
#("123" 1 2 (display #("abc" 1 2 (invisible t)))))))
;; Test `space' property in `display'.
(should (= 2 (org-string-width #(" " 0 1 (display (space :width 2)))))))
;;; Regexp
(ert-deftest test-org/in-regexp ()
"Test `org-in-regexp' specifications."
;; Standard tests.
(should
(org-test-with-temp-text "xx ab<point>c xx"
(org-in-regexp "abc")))
(should-not
(org-test-with-temp-text "xx abc <point>xx"
(org-in-regexp "abc")))
;; Return non-nil even with multiple matching regexps in the same
;; line.
(should
(org-test-with-temp-text "abc xx ab<point>c xx"
(org-in-regexp "abc")))
;; With optional argument NLINES, check extra lines around point.
(should-not
(org-test-with-temp-text "A\nB<point>\nC"
(org-in-regexp "A\nB\nC")))
(should
(org-test-with-temp-text "A\nB<point>\nC"
(org-in-regexp "A\nB\nC" 1)))
(should-not
(org-test-with-temp-text "A\nB\nC<point>"
(org-in-regexp "A\nB\nC" 1)))
;; When optional argument VISUALLY is non-nil, return nil if at
;; regexp boundaries.
(should
(org-test-with-temp-text "xx abc<point> xx"
(org-in-regexp "abc")))
(should-not
(org-test-with-temp-text "xx abc<point> xx"
(org-in-regexp "abc" nil t))))
(provide 'test-org-macs)
;;; test-org-macs.el ends here

261
lisp/org/testing/lisp/test-org-num.el Normal file
View File

@@ -0,0 +1,261 @@
;;; test-org-num.el --- Tests for Org Num library -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This file is not part of GNU Emacs.
;; 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 3 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, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'org-num)
(ert-deftest test-org-num/face ()
"Test `org-num-face' parameter."
(should
(equal
'(foo)
(org-test-with-temp-text "* H1"
(let ((org-num-face 'foo)) (org-num-mode 1))
(mapcar (lambda (o)
(get-text-property 0 'face (overlay-get o 'after-string)))
(overlays-in (point-min) (point-max)))))))
(ert-deftest test-org-num/format-function ()
"Test `org-num-format-function' parameter."
(should
(equal '("foo" "foo")
(org-test-with-temp-text "* H1\n** H2"
(let ((org-num-format-function (lambda (_) "foo")))
(org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Preserve face, when set.
(should
(equal-including-properties
'(#("foo" 0 3 (face bar)))
(org-test-with-temp-text "* H1"
(let ((org-num-format-function
(lambda (_) (org-add-props "foo" nil 'face 'bar))))
(org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Set face override `org-num-face'.
(should
(equal-including-properties
'(#("foo" 0 3 (face bar)))
(org-test-with-temp-text "* H1"
(let ((org-num-face 'baz)
(org-num-format-function
(lambda (_) (org-add-props "foo" nil 'face 'bar))))
(org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max)))))))
(ert-deftest test-org-num/max-level ()
"Test `org-num-max-level' option."
(should
(equal '("1.1 " "1 ")
(org-test-with-temp-text "* H1\n** H2\n*** H3"
(let ((org-num-max-level 2)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max)))))))
(ert-deftest test-org-num/skip-numbering ()
"Test various skip numbering parameters."
;; Skip commented headlines.
(should
(equal '(nil "1 ")
(org-test-with-temp-text "* H1\n* COMMENT H2"
(let ((org-num-skip-commented t)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '("2 " "1 ")
(org-test-with-temp-text "* H1\n* COMMENT H2"
(let ((org-num-skip-commented nil)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Skip commented sub-trees.
(should
(equal '(nil nil)
(org-test-with-temp-text "* COMMENT H1\n** H2"
(let ((org-num-skip-commented t)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Skip footnotes sections.
(should
(equal '(nil "1 ")
(org-test-with-temp-text "* H1\n* FN"
(let ((org-num-skip-footnotes t)
(org-footnote-section "FN"))
(org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '("2 " "1 ")
(org-test-with-temp-text "* H1\n* FN"
(let ((org-num-skip-footnotes nil)
(org-footnote-section "FN"))
(org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Skip tags, recursively.
(should
(equal '(nil "1 ")
(org-test-with-temp-text "* H1\n* H2 :foo:"
(let ((org-num-skip-tags '("foo"))) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '(nil nil)
(org-test-with-temp-text "* H1 :foo:\n** H2"
(let ((org-num-skip-tags '("foo"))) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Skip unnumbered sections.
(should
(equal '(nil "1 ")
(org-test-with-temp-text
"* H1\n* H2\n:PROPERTIES:\n:UNNUMBERED: t\n:END:"
(let ((org-num-skip-unnumbered t)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '("2 " "1 ")
(org-test-with-temp-text
"* H1\n* H2\n:PROPERTIES:\n:UNNUMBERED: t\n:END:"
(let ((org-num-skip-unnumbered nil)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '("2 " "1 ")
(org-test-with-temp-text
"* H1\n* H2\n:PROPERTIES:\n:UNNUMBERED: nil\n:END:"
(let ((org-num-skip-unnumbered t)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Skip unnumbered sub-trees.
(should
(equal '(nil nil)
(org-test-with-temp-text
"* H1\n:PROPERTIES:\n:UNNUMBERED: t\n:END:\n** H2"
(let ((org-num-skip-unnumbered t)) (org-num-mode 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max)))))))
(ert-deftest test-org-num/update ()
"Test numbering update after a buffer modification."
;; Headlines created at BEG.
(should
(equal "1 "
(org-test-with-temp-text "X* H"
(org-num-mode 1)
(delete-char 1)
(overlay-get (car (overlays-at (line-beginning-position)))
'after-string))))
(should
(equal "1 "
(org-test-with-temp-text "*<point>\n H"
(org-num-mode 1)
(delete-char 1)
(overlay-get (car (overlays-at (line-beginning-position)))
'after-string))))
(should
(equal "1 "
(org-test-with-temp-text "*<point>bold*"
(org-num-mode 1)
(insert " ")
(overlay-get (car (overlays-at (line-beginning-position)))
'after-string))))
;; Headlines created at END.
(should
(equal '("1 ")
(org-test-with-temp-text "X<point> H"
(org-num-mode 1)
(insert "\n*")
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '("1 ")
(org-test-with-temp-text "X<point>* H"
(org-num-mode 1)
(insert "\n")
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Headlines created between BEG and END.
(should
(equal '("1.1 " "1 ")
(org-test-with-temp-text ""
(org-num-mode 1)
(insert "\n* H\n** H2")
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Change level of a headline.
(should
(equal '("0.1 ")
(org-test-with-temp-text "* H"
(org-num-mode 1)
(insert "*")
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '("1 ")
(org-test-with-temp-text "*<point>* H"
(org-num-mode 1)
(delete-char 1)
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Alter skip state.
(should
(equal '("1 ")
(org-test-with-temp-text "* H :fo<point>o:"
(let ((org-num-skip-tags '("foo")))
(org-num-mode 1)
(delete-char 1))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
(should
(equal '(nil)
(org-test-with-temp-text "* H :fo<point>:"
(let ((org-num-skip-tags '("foo")))
(org-num-mode 1)
(insert "o"))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))
;; Invalidate an overlay and insert new headlines.
(should
(equal '("1.2 " "1.1 " "1 ")
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:UNNUMBE<point>RED: t\n:END:"
(let ((org-num-skip-unnumbered t))
(org-num-mode 1)
(insert "\n** H2\n** H3\n")
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max)))))))
;; Invalidate two overlays: current headline and next one.
(should
(equal '("1 ")
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:UNNUMBE<point>RED: t\n:END:\n** H2"
(let ((org-num-skip-unnumbered t))
(org-num-mode 1)
(delete-region (point) (line-beginning-position 3))
(mapcar (lambda (o) (overlay-get o 'after-string))
(overlays-in (point-min) (point-max))))))))
(provide 'test-org-num)
;;; org-test-num.el ends here

170
lisp/org/testing/lisp/test-org-pcomplete.el Normal file
View File

@@ -0,0 +1,170 @@
;;; test-org-pcomplete.el --- test pcomplete integration
;; Copyright (C) 2015-2016, 2019 Alexey Lebedeff
;; Authors: Alexey Lebedeff
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Comments:
;;; Code:
(ert-deftest test-org-pcomplete/clocktable ()
"Test completion of clock table parameters."
(should
(equal "#+begin: clocktable :scope"
(org-test-with-temp-text "#+begin: clocktable :sco<point>"
(pcomplete)
(buffer-string)))))
(ert-deftest test-org-pcomplete/drawer ()
"Test drawer completion."
(should
(equal "* Foo\n:PROPERTIES:"
(org-test-with-temp-text "* Foo\n:<point>"
(pcomplete)
(buffer-string))))
(should
(equal ":DRAWER:\nContents\n:END:\n* Foo\n:DRAWER:"
(org-test-with-temp-text ":DRAWER:\nContents\n:END:\n* Foo\n:D<point>"
(pcomplete)
(buffer-string)))))
(ert-deftest test-org-pcomplete/entity ()
"Test entity completion."
(should
(equal "\\alpha"
(org-test-with-temp-text "\\alp<point>"
(pcomplete)
(buffer-string))))
(should
(equal "\\frac12"
(org-test-with-temp-text "\\frac1<point>"
(pcomplete)
(buffer-string)))))
(ert-deftest test-org-pcomplete/keyword ()
"Test keyword and block completion."
(should
(string-prefix-p
"#+startup: "
(org-test-with-temp-text "#+start<point>"
(pcomplete)
(buffer-string))
t))
(should
(string-prefix-p
"#+begin_center"
(org-test-with-temp-text "#+begin_ce<point>"
(pcomplete)
(buffer-string))
t)))
(ert-deftest test-org-pcomplete/link ()
"Test link completion"
(should
(equal "[[org:"
(org-test-with-temp-text "[[o<point>"
(let ((org-link-abbrev-alist '(("org" . "https://orgmode.org/"))))
(pcomplete))
(buffer-string))))
(should-not
(equal "[org:"
(org-test-with-temp-text "[[o<point>"
(let ((org-link-abbrev-alist '(("org" . "https://orgmode.org/"))))
(pcomplete))
(buffer-string)))))
(ert-deftest test-org-pcomplete/prop ()
"Test property completion."
(should
(equal
"
* a
:PROPERTIES:
:pname:\s
:END:
* b
:PROPERTIES:
:pname: pvalue
:END:
"
(org-test-with-temp-text "
* a
:PROPERTIES:
:pna<point>
:END:
* b
:PROPERTIES:
:pname: pvalue
:END:
"
(pcomplete)
(buffer-string)))))
(ert-deftest test-org-pcomplete/search-heading ()
"Test search heading completion."
(should
(equal "* Foo\n[[*Foo"
(org-test-with-temp-text "* Foo\n[[*<point>"
(pcomplete)
(buffer-string)))))
(ert-deftest test-org-pcomplete/tag ()
"Test tag completion."
;; Complete at end of line, according to `org-current-tag-alist'.
(should
(equal "* H :foo:"
(org-test-with-temp-text "* H :<point>"
(let ((org-current-tag-alist '(("foo")))) (pcomplete))
(buffer-string))))
(should
(equal "* H :foo:bar:"
(org-test-with-temp-text "* H :foo:b<point>"
(let ((org-current-tag-alist '(("bar")))) (pcomplete))
(buffer-string))))
;; If `org-current-tag-alist' is non-nil, complete against tags in
;; buffer.
(should
(equal "* H1 :bar:\n* H2 :bar:"
(org-test-with-temp-text "* H1 :bar:\n* H2 :<point>"
(let ((org-current-tag-alist nil)) (pcomplete))
(buffer-string))))
;; Do not complete in the middle of a line.
(should
(equal "* H :notag: :real:tags:"
(org-test-with-temp-text "* H :notag:<point> :real:tags:"
(let ((org-current-tag-alist '(("foo")))) (pcomplete))
(buffer-string))))
;; Complete even when there's a match on the line.
(should
(equal "* foo: :foo:"
(org-test-with-temp-text "* foo: :<point>"
(let ((org-current-tag-alist '(("foo")))) (pcomplete))
(buffer-string)))))
(ert-deftest test-org-pcomplete/todo ()
"Test TODO completion."
(should
(equal "* TODO"
(org-test-with-temp-text "* T<point>"
(pcomplete)
(buffer-string)))))
(provide 'test-org-pcomplete)
;;; test-org-pcomplete.el ends here

206
lisp/org/testing/lisp/test-org-protocol.el Normal file
View File

@@ -0,0 +1,206 @@
;;; test-org-protocol.el --- tests for org-protocol.el -*- lexical-binding: t; -*-
;; Copyright (c) Sacha Chua
;; Authors: Sacha Chua
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(unless (featurep 'org-protocol)
(signal 'missing-test-dependency "Support for org-protocol"))
(ert-deftest test-org-protocol/org-protocol-parse-parameters ()
"Test `org-protocol-parse-parameters' specifications."
;; Ignore lists
(let ((data (org-protocol-parse-parameters '(:url "abc" :title "def") nil)))
(should (string= (plist-get data :url) "abc"))
(should (string= (plist-get data :title) "def")))
;; Parse new-style links
(let ((data (org-protocol-parse-parameters "url=abc&title=def" t)))
(should (string= (plist-get data :url) "abc"))
(should (string= (plist-get data :title) "def")))
;; Parse new-style complex links
(let* ((url (concat "template=p&"
"url=https%3A%2F%2Forgmode.org%2Forg.html%23capture-protocol&"
"title=The%20Org%20Manual&"
"body=9.4.2%20capture%20protocol"))
(data (org-protocol-parse-parameters url)))
(should (string= (plist-get data :template) "p"))
(should (string= (plist-get data :url) "https://orgmode.org/org.html#capture-protocol"))
(should (string= (plist-get data :title) "The Org Manual"))
(should (string= (plist-get data :body) "9.4.2 capture protocol")))
;; Parse old-style links
(let ((data (org-protocol-parse-parameters "abc/def" nil '(:url :title))))
(should (string= (plist-get data :url) "abc"))
(should (string= (plist-get data :title) "def")))
;; Parse old-style links even without keys
(let ((data (org-protocol-parse-parameters "b/abc/def" nil)))
(should (equal data '("b" "abc" "def"))))
;; Parse old-style links with key/val pairs
(let ((data (org-protocol-parse-parameters "b/abc/extrakey/extraval" nil '(:param1 :param2))))
(should (string= (plist-get data :param1) "b"))
(should (string= (plist-get data :param2) "abc"))
(should (string= (plist-get data :extrakey) "extraval"))))
(ert-deftest test-org-protocol/org-protocol-store-link ()
"Test `org-protocol-store-link' specifications."
;; Old link style
(let ((uri "/some/directory/org-protocol:/store-link:/URL/TITLE"))
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
(should (equal (car org-stored-links) '("URL" "TITLE"))))
;; URL encoded
(let ((uri (format "/some/directory/org-protocol:/store-link:/%s/TITLE"
(url-hexify-string "http://example.com"))))
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
(should (equal (car org-stored-links) '("http://example.com" "TITLE"))))
;; Handle multiple slashes, old link style
(let ((uri "/some/directory/org-protocol://store-link://URL2//TITLE2"))
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
(should (equal (car org-stored-links) '("URL2" "TITLE2"))))
;; New link style
(let ((uri "/some/directory/org-protocol://store-link?url=URL3&title=TITLE3"))
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
(should (equal (car org-stored-links) '("URL3" "TITLE3")))))
(ert-deftest test-org-protocol/org-protocol-capture ()
"Test `org-protocol-capture' specifications."
(let* ((org-protocol-default-template-key "t")
(temp-file-name (make-temp-file "org-protocol-test"))
(org-capture-templates
`(("t" "Test" entry (file ,temp-file-name) "** TODO\n\n%i\n\n%a\n" :kill-buffer t)
("x" "With params" entry (file ,temp-file-name) "** SOMEDAY\n\n%i\n\n%a\n" :kill-buffer t)
("X" "Just the template" entry (file ,temp-file-name) "** Hello World\n\n%i\n\nGoodbye World\n" :kill-buffer t)))
(test-urls
'(
;; Old style:
;; - multiple slashes
("/some/directory/org-protocol:/capture:/URL/TITLE"
. "** TODO\n\n\n\n[[URL][TITLE]]\n")
;; - body specification
("/some/directory/org-protocol:/capture:/URL/TITLE/BODY"
. "** TODO\n\nBODY\n\n[[URL][TITLE]]\n")
;; - template
("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY"
. "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
;; - query parameters, not sure how to include them in template
("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY/from/example"
. "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
;; New style:
;; - multiple slashes
("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE"
. "** TODO\n\n\n\n[[NEWURL][TITLE]]\n")
;; - body specification
("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE&body=BODY"
. "** TODO\n\nBODY\n\n[[NEWURL][TITLE]]\n")
;; - template
("/some/directory/org-protocol:/capture?template=x&url=NEWURL&title=TITLE&body=BODY"
. "** SOMEDAY\n\nBODY\n\n[[NEWURL][TITLE]]\n")
;; - no url specified
("/some/directory/org-protocol:/capture?template=x&title=TITLE&body=BODY"
. "** SOMEDAY\n\nBODY\n\nTITLE\n")
;; - no title specified
("/some/directory/org-protocol:/capture?template=x&url=NEWURL&body=BODY"
. "** SOMEDAY\n\nBODY\n\n[[NEWURL][NEWURL]]\n")
;; - just the template
("/some/directory/org-protocol:/capture?template=X"
. "** Hello World\n\n\n\nGoodbye World\n")
;; - query parameters, not sure how to include them in template
("/some/directory/org-protocol:/capture?template=x&url=URL&title=TITLE&body=BODY&from=example"
. "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
)))
;; Old link style
(mapc
(lambda (test-case)
(let ((uri (car test-case)))
(org-protocol-check-filename-for-protocol uri (list uri) nil)
(should (string= (buffer-string) (cdr test-case)))
(org-capture-kill)))
test-urls)
(delete-file temp-file-name)))
(ert-deftest test-org-protocol/org-protocol-open-source ()
"Test org-protocol://open-source links."
(let* ((temp-file-name1 (make-temp-file "org-protocol-test1"))
(temp-file-name2 (make-temp-file "org-protocol-test2"))
(org-protocol-project-alist
`((test1
:base-url "http://example.com/"
:online-suffix ".html"
:working-directory ,(file-name-directory temp-file-name1))
(test2
:base-url "http://another.example.com/"
:online-suffix ".js"
:working-directory ,(file-name-directory temp-file-name2))
(test3
:base-url "https://blog-example.com/"
:working-directory ,(file-name-directory temp-file-name2)
:online-suffix ".html"
:working-suffix ".md"
:rewrites (("\\(https://blog-example.com/[0-9]+/[0-9]+/[0-9]+/\\)" . ".md")))))
(test-cases
(list
;; Old-style URLs
(cons
(concat "/some/directory/org-protocol:/open-source:/"
(url-hexify-string
(concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
temp-file-name1)
(cons
(concat "/some/directory/org-protocol:/open-source:/"
(url-hexify-string
(concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
temp-file-name2)
;; New-style URLs
(cons
(concat "/some/directory/org-protocol:/open-source?url="
(url-hexify-string
(concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
temp-file-name1)
(cons
(concat "/some/directory/org-protocol:/open-source?url="
(url-hexify-string
(concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
temp-file-name2))))
(mapc (lambda (test-case)
(should (string=
(org-protocol-check-filename-for-protocol
(car test-case)
(list (car test-case)) nil)
(cdr test-case))))
test-cases)
(delete-file temp-file-name1)
(delete-file temp-file-name2)))
(defun test-org-protocol/org-protocol-greedy-handler (fname)
;; fname should be a list of parsed items
(should (listp fname))
nil)
(ert-deftest test-org-protocol/org-protocol-with-greedy-handler ()
"Check that greedy handlers are called with all the filenames."
(let ((org-protocol-protocol-alist
'(("protocol-a" :protocol "greedy" :function test-org-protocol/org-protocol-greedy-handler :kill-client t :greedy t))))
;; Neither of these should signal errors
(let ((uri "/some/dir/org-protocol://greedy?a=b&c=d")
(uri2 "/some/dir/org-protocol://greedy?e=f&g=h"))
(org-protocol-check-filename-for-protocol uri (list uri uri2) nil))))
;; TODO: Verify greedy protocol handling
;;; test-org-protocol.el ends here

485
lisp/org/testing/lisp/test-org-src.el Normal file
View File

@@ -0,0 +1,485 @@
;;; test-org-src.el --- tests for org-src.el
;; Copyright (C) 2012-2015, 2019 Le Wang
;; Author: Le Wang <l26wang at gmail dot com>
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'org-test)
(ert-deftest test-org-src/basic ()
"Editing regular block works, with point on source block."
(org-test-with-temp-text
"
<point>#+begin_src emacs-lisp
(message hello)
#+end_src
"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation nil))
(org-edit-special)
(insert "blah")
(org-edit-src-exit)
(should (equal (buffer-string) "
#+begin_src emacs-lisp
blah(message hello)
#+end_src
"))
(should (looking-at-p "(message hello)")))))
(ert-deftest test-org-src/point-outside-block ()
"Editing with point before/after block signals expected error."
(org-test-with-temp-text
"
#+begin_src emacs-lisp
(message hello)
#+end_src
"
(goto-line 1)
(should-error (org-edit-special))
(goto-char (point-max))
(should-error (org-edit-special))))
(ert-deftest test-org-src/empty-block ()
"Editing empty block."
(org-test-with-temp-text
"
<point>#+begin_src emacs-lisp
#+end_src
"
(let ((org-edit-src-content-indentation 0)
(org-src-preserve-indentation nil))
(org-edit-special)
(insert "blah")
(org-edit-src-exit)
(should (equal (buffer-string) "
#+begin_src emacs-lisp
blah
#+end_src
"))
(should
(equal (buffer-substring (line-beginning-position) (point)) "blah")))))
(ert-deftest test-org-src/blank-line-block ()
"Editing block with just a blank line."
(org-test-with-temp-text-in-file
"
#+begin_src emacs-lisp
#+end_src
"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation nil))
(goto-line 2)
(org-edit-special)
(insert "blah")
(org-edit-src-exit)
(should (equal (buffer-string) "
#+begin_src emacs-lisp
blah
#+end_src
")))))
(ert-deftest test-org-src/preserve-tabs ()
"Editing block preserve tab characters."
;; With `org-src-preserve-indentation' set to nil.
(should
(equal "
#+begin_src emacs-lisp
This is a tab:\t.
#+end_src"
(org-test-with-temp-text
"
#+begin_src emacs-lisp
<point>This is a tab:\t.
#+end_src"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation nil))
(org-edit-special)
(org-edit-src-exit)
(buffer-string)))))
;; With `org-src-preserve-indentation' set to t.
(should
(equal "
#+begin_src emacs-lisp
This is a tab:\t.
#+end_src"
(org-test-with-temp-text
"
#+begin_src emacs-lisp
<point>This is a tab:\t.
#+end_src"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation t))
(org-edit-special)
(org-edit-src-exit)
(buffer-string))))))
(ert-deftest test-org-src/coderef-format ()
"Test `org-src-coderef-format' specifications."
;; Regular tests in a src block, an example block and an edit
;; buffer.
(should
(equal "foo"
(let ((org-coderef-label-format "foo"))
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n0\n#+END_SRC"
(org-src-coderef-format)))))
(should
(equal "foo"
(let ((org-coderef-label-format "foo"))
(org-test-with-temp-text "#+BEGIN_EXAMPLE\n0\n#+END_EXAMPLE"
(org-src-coderef-format)))))
(should
(equal "foo"
(let ((org-coderef-label-format "foo") result)
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n0\n#+END_SRC"
(org-edit-special)
(setq result (org-src-coderef-format))
(org-edit-src-exit)
result))))
;; When a local variable in the source buffer is available, use it.
(should
(equal "bar"
(let ((org-coderef-label-format "foo"))
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n0\n#+END_SRC"
(setq-local org-coderef-label-format "bar")
(org-src-coderef-format)))))
(should
(equal "bar"
(let ((org-coderef-label-format "foo") result)
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n0\n#+END_SRC"
(setq-local org-coderef-label-format "bar")
(org-edit-special)
(setq result (org-src-coderef-format))
(org-edit-src-exit)
result))))
;; Use provided local format even if in an edit buffer.
(should
(equal "bar"
(let ((org-coderef-label-format "foo"))
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"bar\"\n0\n#+END_SRC"
(org-src-coderef-format)))))
(should
(equal "bar"
(let ((org-coderef-label-format "foo") result)
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"bar\"\n0\n#+END_SRC"
(org-edit-special)
(setq result (org-src-coderef-format))
(org-edit-src-exit)
result))))
;; Local format has precedence over local variables.
(should
(equal "bar"
(let ((org-coderef-label-format "foo"))
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"bar\"\n0\n#+END_SRC"
(setq-local org-coderef-label-format "foo")
(org-src-coderef-format)))))
(should
(equal "bar"
(let ((org-coderef-label-format "foo") result)
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"bar\"\n0\n#+END_SRC"
(setq-local org-coderef-label-format "foo")
(org-edit-special)
(setq result (org-src-coderef-format))
(org-edit-src-exit)
result))))
;; When optional argument provides a coderef format string, use it.
(should
(equal "bar"
(let ((org-coderef-label-format "foo")
(element (org-element-create 'src-block '(:label-fmt "bar"))))
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n0\n#+END_SRC"
(org-src-coderef-format element)))))
(should
(equal "baz"
(let ((org-coderef-label-format "foo")
(element (org-element-create 'src-block '(:label-fmt "baz"))))
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"bar\"\n0\n#+END_SRC"
(setq-local org-coderef-label-format "foo")
(org-src-coderef-format element)))))
;; If it doesn't provide any label format string, fall back to
;; regular checks.
(should
(equal "foo"
(let ((org-coderef-label-format "foo")
(element (org-element-create 'src-block)))
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n0\n#+END_SRC"
(org-src-coderef-format element)))))
(should
(equal "bar"
(let ((org-coderef-label-format "foo")
(element (org-element-create 'src-block)))
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"bar\"\n0\n#+END_SRC"
(setq-local org-coderef-label-format "foo")
(org-src-coderef-format element))))))
(ert-deftest test-org-src/coderef-regexp ()
"Test `org-src-coderef-regexp' specifications."
;; Regular test.
(should
(string-match-p (org-src-coderef-regexp "; ref:%s")
"#+BEGIN_SRC emacs-lisp\n0; ref:label\n#+END_SRC"))
;; Ignore white space around the coderef.
(should
(string-match-p (org-src-coderef-regexp "; ref:%s")
"#+BEGIN_SRC emacs-lisp\n0 ; ref:label\n#+END_SRC"))
(should
(string-match-p (org-src-coderef-regexp "; ref:%s")
"#+BEGIN_SRC emacs-lisp\n0 ; ref:label \n#+END_SRC"))
;; Only match regexp at the end of the line.
(should-not
(string-match-p (org-src-coderef-regexp "; ref:%s")
"#+BEGIN_SRC emacs-lisp\n0; ref:label (+ 1 2)\n#+END_SRC"))
;; Do not match an empty label.
(should-not
(string-match-p (org-src-coderef-regexp "; ref:%s")
"#+BEGIN_SRC emacs-lisp\n0; ref:\n#+END_SRC"))
;; When optional argument LABEL is provided, match given label only.
(should
(string-match-p (org-src-coderef-regexp "; ref:%s" "label")
"#+BEGIN_SRC emacs-lisp\n0; ref:label\n#+END_SRC"))
(should-not
(string-match-p (org-src-coderef-regexp "; ref:%s" "label2")
"#+BEGIN_SRC emacs-lisp\n0; ref:label\n#+END_SRC")))
(ert-deftest test-org-src/indented-blocks ()
"Test editing indented blocks."
;; Editing a block should preserve its global indentation, unless
;; `org-src-preserve-indentation' is non-nil.
(should
(equal
"- Item\n #+BEGIN_SRC emacs-lisp\n Foo\n #+END_SRC"
(org-test-with-temp-text
"- Item\n<point> #+BEGIN_SRC emacs-lisp\n (+ 1 1)\n #+END_SRC"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation nil))
(org-edit-special)
(erase-buffer)
(insert "Foo")
(org-edit-src-exit)
(buffer-string)))))
(should
(equal
"- Item\n #+BEGIN_SRC emacs-lisp\n Foo\n #+END_SRC"
(org-test-with-temp-text
"- Item\n<point> #+BEGIN_SRC emacs-lisp\n (+ 1 1)\n #+END_SRC"
(let ((org-src-preserve-indentation t))
(org-edit-special)
(erase-buffer)
(insert " Foo")
(org-edit-src-exit)
(buffer-string)))))
;; Global indentation obeys `indent-tabs-mode' from the original
;; buffer.
(should
(string-match-p
"^\t+\s*argument2"
(org-test-with-temp-text
"
- Item
#+BEGIN_SRC emacs-lisp<point>
(progn
(function argument1
argument2))
#+END_SRC"
(setq-local indent-tabs-mode t)
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation nil))
(org-edit-special)
(org-edit-src-exit)
(buffer-string)))))
(should
(string-match-p
"^\s+argument2"
(org-test-with-temp-text
"
- Item
#+BEGIN_SRC emacs-lisp<point>
(progn\n (function argument1\n\t\targument2))
#+END_SRC"
(setq-local indent-tabs-mode nil)
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation nil))
(org-edit-special)
(org-edit-src-exit)
(buffer-string)))))
;; Global indentation also obeys `tab-width' from original buffer.
(should
(string-match-p
"^\t\\{3\\}\s\\{2\\}argument2"
(org-test-with-temp-text
"
- Item
#+BEGIN_SRC emacs-lisp<point>
(progn
(function argument1
argument2))
#+END_SRC"
(setq-local indent-tabs-mode t)
(setq-local tab-width 4)
(let ((org-edit-src-content-indentation 0)
(org-src-preserve-indentation nil))
(org-edit-special)
(org-edit-src-exit)
(buffer-string)))))
(should
(string-match-p
"^\t\s\\{6\\}argument2"
(org-test-with-temp-text
"
- Item
#+BEGIN_SRC emacs-lisp<point>
(progn
(function argument1
argument2))
#+END_SRC"
(setq-local indent-tabs-mode t)
(setq-local tab-width 8)
(let ((org-edit-src-content-indentation 0)
(org-src-preserve-indentation nil))
(org-edit-special)
(org-edit-src-exit)
(buffer-string))))))
(ert-deftest test-org-src/footnote-references ()
"Test editing footnote references."
;; Error when there is no definition to edit.
(should-error
(org-test-with-temp-text "A footnote<point>[fn:1]"
(org-edit-special)))
;; Error when trying to edit an anonymous footnote.
(should-error
(org-test-with-temp-text "A footnote[fn::<point>edit me!]"
(org-edit-special)))
;; Edit a regular definition.
(should
(equal "[fn:1] Definition"
(org-test-with-temp-text "A footnote<point>[fn:1]\n[fn:1] Definition"
(org-edit-special)
(prog1 (buffer-string) (org-edit-src-exit)))))
;; Label should be protected against editing.
(should
(org-test-with-temp-text "A footnote<point>[fn:1]\n[fn:1] Definition"
(org-edit-special)
(prog1 (get-text-property 0 'read-only (buffer-string))
(org-edit-src-exit))))
(should
(org-test-with-temp-text "A footnote<point>[fn:1]\n[fn:1] Definition"
(org-edit-special)
(prog1 (get-text-property 5 'read-only (buffer-string))
(org-edit-src-exit))))
;; Edit a regular definition.
(should
(equal
"A footnote[fn:1][fn:2]\n[fn:1] D1\n\n[fn:2] D2"
(org-test-with-temp-text
"A footnote<point>[fn:1][fn:2]\n[fn:1] D1\n\n[fn:2] D2"
(org-edit-special)
(org-edit-src-exit)
(buffer-string))))
;; Edit an inline definition.
(should
(equal
"[fn:1:definition]"
(org-test-with-temp-text
"An inline<point>[fn:1] footnote[fn:1:definition]"
(org-edit-special)
(prog1 (buffer-string) (org-edit-src-exit)))))
;; Label and closing square bracket should be protected against
;; editing.
(should
(org-test-with-temp-text "An inline<point>[fn:1] footnote[fn:1:definition]"
(org-edit-special)
(prog1 (get-text-property 0 'read-only (buffer-string))
(org-edit-src-exit))))
(should
(org-test-with-temp-text "An inline<point>[fn:1] footnote[fn:1:definition]"
(org-edit-special)
(prog1 (get-text-property 5 'read-only (buffer-string))
(org-edit-src-exit))))
(should
(org-test-with-temp-text "An inline<point>[fn:1] footnote[fn:1:definition]"
(org-edit-special)
(prog1 (get-text-property 16 'read-only (buffer-string))
(org-edit-src-exit))))
;; Do not include trailing white spaces when displaying the inline
;; footnote definition.
(should
(equal
"[fn:1:definition]"
(org-test-with-temp-text
"An inline<point>[fn:1] footnote[fn:1:definition] and some text"
(org-edit-special)
(prog1 (buffer-string) (org-edit-src-exit)))))
;; Preserve local variables when editing a footnote definition.
(should
(eq 'bar
(org-test-with-temp-text "A footnote<point>[fn:1]\n[fn:1] Definition"
(setq-local foo 'bar)
(org-edit-special)
(prog1 foo (org-edit-src-exit))))))
;;; Code escaping
(ert-deftest test-org-src/escape-code-in-string ()
"Test `org-escape-code-in-string' specifications."
;; Escape lines starting with "*" or "#+".
(should (equal ",*" (org-escape-code-in-string "*")))
(should (equal ",#+" (org-escape-code-in-string "#+")))
;; Escape lines starting with ",*" and ",#+". Number of leading
;; commas does not matter.
(should (equal ",,*" (org-escape-code-in-string ",*")))
(should (equal ",,#+" (org-escape-code-in-string ",#+")))
(should (equal ",,,*" (org-escape-code-in-string ",,*")))
(should (equal ",,,#+" (org-escape-code-in-string ",,#+")))
;; Indentation does not matter.
(should (equal " ,*" (org-escape-code-in-string " *")))
(should (equal " ,#+" (org-escape-code-in-string " #+")))
;; Do nothing on other cases.
(should (equal "a" (org-escape-code-in-string "a")))
(should (equal "#" (org-escape-code-in-string "#")))
(should (equal "," (org-escape-code-in-string ","))))
(ert-deftest test-org-src/unescape-code-in-string ()
"Test `org-unescape-code-in-string' specifications."
;; Unescape lines starting with ",*" or ",#+". Number of leading
;; commas does not matter.
(should (equal "*" (org-unescape-code-in-string ",*")))
(should (equal "#+" (org-unescape-code-in-string ",#+")))
(should (equal ",*" (org-unescape-code-in-string ",,*")))
(should (equal ",#+" (org-unescape-code-in-string ",,#+")))
;; Indentation does not matter.
(should (equal " *" (org-unescape-code-in-string " ,*")))
(should (equal " #+" (org-unescape-code-in-string " ,#+")))
;; Do nothing on other cases.
(should (equal "a" (org-unescape-code-in-string "a")))
(should (equal "#" (org-unescape-code-in-string "#")))
(should (equal "," (org-unescape-code-in-string ","))))
(provide 'test-org-src)
;;; test-org-src.el ends here

3236
lisp/org/testing/lisp/test-org-table.el Normal file
View File

File diff suppressed because it is too large Load Diff

115
lisp/org/testing/lisp/test-org-tempo.el Normal file
View File

@@ -0,0 +1,115 @@
;;; test-org-tempo.el --- Tests for test-org-tempo.el -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2019 Rasmus Pank Roulund
;; Author: Rasmus Pank Roulund <emacs at pank dot eu>
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'org-tempo)
(unless (featurep 'org-tempo)
(signal 'missing-test-dependency "org-tempo"))
(ert-deftest test-org-tempo/completion ()
"Test that blocks and keywords are expanded correctly by org-tempo."
;; Tempo completion should recognize snippet keywords and expand with tab
(should
(equal (org-test-with-temp-text "<L<point>"
(org-tempo-setup)
(tempo-complete-tag)
(buffer-string))
"#+latex: "))
;; Tempo completion should recognize snippet Blocks
(should
(equal (org-test-with-temp-text "<l<point>"
(org-tempo-setup)
(call-interactively 'org-cycle)
(buffer-string))
"#+begin_export latex\n\n#+end_export"))
;; Tab should work for expansion.
(should
(equal (org-test-with-temp-text "<L<point>"
(org-tempo-setup)
(tempo-complete-tag)
(buffer-string))
(org-test-with-temp-text "<L<point>"
(org-tempo-setup)
(org-cycle)
(buffer-string))))
;; Tempo should not expand unknown snippets
(equal (org-test-with-temp-text "<k"
(org-tempo-setup)
(call-interactively 'org-cycle)
(buffer-string))
"<k"))
(ert-deftest test-org-tempo/space-first-line ()
"Test space on first line after expansion."
;; Normal blocks should have no space at the end of the first line.
(should (zerop
(org-test-with-temp-text "<l<point>"
(org-tempo-setup)
(tempo-complete-tag)
(goto-char (point-min))
(end-of-line)
(skip-chars-backward " "))))
;; src blocks, export blocks and keywords should have one space at
;; the end of the first line.
(should (cl-every (apply-partially 'eq 1)
(mapcar (lambda (s)
(org-test-with-temp-text (format "<%s<point>" s)
(org-tempo-setup)
(tempo-complete-tag)
(goto-char (point-min))
(end-of-line)
(abs (skip-chars-backward " "))))
'("s" "E" "L")))))
(ert-deftest test-org-tempo/cursor-placement ()
"Test the placement of the cursor after tempo expand"
;; Normal blocks place point "inside" block.
(should
(eq (org-test-with-temp-text "<l<point>"
(org-tempo-setup)
(tempo-complete-tag)
(point))
(length "#\\+begin_export latex\n")))
;; Special block stop at end of #+begin line.
(should
(eq (org-test-with-temp-text "<s<point>"
(org-tempo-setup)
(tempo-complete-tag)
(point))
(length "#\\+begin_src "))))
(ert-deftest test-org-tempo/add-new-templates ()
"Test that new structures and keywords are added correctly."
;; New blocks should be added.
(should
(let ((org-structure-template-alist '(("n" . "new_block"))))
(org-tempo-add-templates)
(assoc "<l" org-tempo-tags)))
;; New keys should be added.
(should
(let ((org-tempo-keywords-alist '(("N" . "new_keyword"))))
(org-tempo-add-templates)
(assoc "<N" org-tempo-tags))))
(provide 'test-org-tempo)
;;; test-org-tempo.el end here

300
lisp/org/testing/lisp/test-org-timer.el Normal file
View File

@@ -0,0 +1,300 @@
;;; test-org-timer.el --- Tests for org-timer.el
;; Copyright (C) 2014-2015, 2019 Kyle Meyer
;; Author: Kyle Meyer <kyle@kyleam.com>
;; This file is not part of GNU Emacs.
;; 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 3 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, see <http://www.gnu.org/licenses/>.
;;; Code:
(eval-and-compile (require 'cl-lib))
(defmacro test-org-timer/with-temp-text (text &rest body)
"Like `org-test-with-temp-text', but set timer-specific variables.
Also, mute output from `message'."
(declare (indent 1))
`(cl-letf (((symbol-function 'message) (lambda (&rest args) nil)))
(org-test-with-temp-text ,text
(let (org-timer-start-time
org-timer-pause-time
org-timer-countdown-timer
org-timer-display)
(unwind-protect (progn ,@body)
(when (timerp org-timer-countdown-timer)
(cancel-timer org-timer-countdown-timer)))))))
(defmacro test-org-timer/with-current-time (time &rest body)
"Run BODY, setting `current-time' output to TIME."
(declare (indent 1))
`(org-test-at-time ,time ,@body))
;;; Time conversion and formatting
(ert-deftest test-org-timer/secs-to-hms ()
"Test conversion between HMS format and seconds."
;; Seconds to HMS, and back again
(should
(equal "0:00:30"
(org-timer-secs-to-hms 30)))
(should
(equal 30
(org-timer-hms-to-secs (org-timer-secs-to-hms 30))))
;; Minutes to HMS, and back again
(should
(equal "0:02:10"
(org-timer-secs-to-hms 130)))
(should
(equal 130
(org-timer-hms-to-secs (org-timer-secs-to-hms 130))))
;; Hours to HMS, and back again
(should
(equal "1:01:30"
(org-timer-secs-to-hms 3690)))
(should
(equal 3690
(org-timer-hms-to-secs (org-timer-secs-to-hms 3690))))
;; Negative seconds to HMS, and back again
(should
(equal "-1:01:30"
(org-timer-secs-to-hms -3690)))
(should
(equal -3690
(org-timer-hms-to-secs (org-timer-secs-to-hms -3690)))))
(ert-deftest test-org-timer/fix-incomplete ()
"Test conversion to complete HMS format."
;; No fix is needed.
(should
(equal "1:02:03"
(org-timer-fix-incomplete "1:02:03")))
;; Hour is missing.
(should
(equal "0:02:03"
(org-timer-fix-incomplete "02:03")))
;; Minute is missing.
(should
(equal "0:00:03"
(org-timer-fix-incomplete "03"))))
(ert-deftest test-org-timer/change-times ()
"Test changing HMS format by offset."
;; Add time.
(should
(equal "
1:31:15
4:00:55"
(org-test-with-temp-text "
0:00:25
2:30:05"
(org-timer-change-times-in-region (point-min) (point-max)
"1:30:50")
(buffer-string))))
;; Subtract time.
(should
(equal "
-1:30:25
0:59:15"
(org-test-with-temp-text "
0:00:25
2:30:05"
(org-timer-change-times-in-region (point-min) (point-max)
"-1:30:50")
(buffer-string)))))
;;; Timers
;; Dummy times for overriding `current-time'
(defvar test-org-timer/time0 '(21635 62793 797149 675000))
;; Add 3 minutes and 26 seconds.
(defvar test-org-timer/time1
(time-add test-org-timer/time0 (seconds-to-time 206)))
;; Add 2 minutes and 41 seconds (6 minutes and 7 seconds total).
(defvar test-org-timer/time2
(time-add test-org-timer/time1 (seconds-to-time 161)))
;; Add 4 minutes and 55 seconds (11 minutes and 2 seconds total).
(defvar test-org-timer/time3
(time-add test-org-timer/time2 (seconds-to-time 295)))
(ert-deftest test-org-timer/start-relative ()
"Test starting relative timer."
;; Insert plain timer string, starting with `org-timer-start'.
(should
(equal "0:03:26"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer))
(org-trim (buffer-string)))))
;; Insert item timer string.
(should
(equal "- 0:03:26 ::"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-item))
(org-trim (buffer-string)))))
;; Start with `org-timer'.
(should
(equal "0:00:00 0:03:26"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer))
(org-trim (buffer-string)))))
;; Restart with `org-timer'.
(should
(equal "0:00:00"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer '(4)))
(org-trim (buffer-string))))))
(ert-deftest test-org-timer/set-timer ()
"Test setting countdown timer."
(should
(equal "0:06:34"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-set-timer 10))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer))
(org-trim (buffer-string)))))
(should
(equal "0:00:04"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-set-timer "3:30"))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer))
(org-trim (buffer-string))))))
(ert-deftest test-org-timer/pause-timer ()
"Test pausing relative and countdown timers."
;; Pause relative timer.
(should
(equal "0:03:26"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-pause-or-continue))
(org-timer)
(org-trim (buffer-string)))))
;; Pause then continue relative timer.
(should
(equal "0:08:21"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-pause-or-continue))
(test-org-timer/with-current-time test-org-timer/time2
(org-timer-pause-or-continue))
(test-org-timer/with-current-time test-org-timer/time3
(org-timer))
(org-trim (buffer-string)))))
;; Pause then continue countdown timer.
(should
(equal "0:01:39"
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-set-timer 10))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-pause-or-continue))
(test-org-timer/with-current-time test-org-timer/time2
(org-timer-pause-or-continue))
(test-org-timer/with-current-time test-org-timer/time3
(org-timer))
(org-trim (buffer-string))))))
(ert-deftest test-org-timer/stop ()
"Test stopping relative and countdown timers."
;; Stop running relative timer.
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-stop))
(should-not org-timer-start-time))
;; Stop paused relative timer.
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-start))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-pause-or-continue)
(org-timer-stop))
(should-not org-timer-start-time)
(should-not org-timer-pause-time))
;; Stop running countdown timer.
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-set-timer 10))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-stop))
(should-not org-timer-start-time)
(should-not org-timer-countdown-timer))
;; Stop paused countdown timer.
(test-org-timer/with-temp-text ""
(test-org-timer/with-current-time test-org-timer/time0
(org-timer-set-timer 10))
(test-org-timer/with-current-time test-org-timer/time1
(org-timer-pause-or-continue)
(org-timer-stop))
(should-not org-timer-start-time)
(should-not org-timer-pause-time)
(should-not org-timer-countdown-timer)))
(ert-deftest test-org-timer/other-timer-error ()
"Test for error when other timer running."
;; Relative timer is running.
(should-error
(test-org-timer/with-temp-text ""
(org-timer-start)
(org-timer-set-timer 10))
:type (list 'error 'user-error))
;; Countdown timer is running.
(should-error
(test-org-timer/with-temp-text ""
(org-timer-set-timer 10)
(org-timer-start))
:type (list 'error 'user-error)))
(ert-deftest test-org-timer/set-timer-from-effort-prop ()
"Test timer setting from effort property."
(should
(< (* 60 9) ; 9m
(test-org-timer/with-temp-text
"* foo
:PROPERTIES:
:Effort: 10
:END:"
(org-mode)
(org-timer-set-timer)
(org-timer-hms-to-secs (org-timer nil t)))
(1+ (* 60 10)) ; 10m 1s
)))
(provide 'test-org-timer)
;;; test-org-timer.el end here

7357
lisp/org/testing/lisp/test-org.el Normal file
View File

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More