summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom Breton (Tehom) <tehom@panix.com>2010-05-17 18:18:34 -0400
committerTom Breton (Tehom) <tehom@panix.com>2010-05-17 18:18:34 -0400
commit2db83d6a39c0dbffb70b58e9dce8e2bddf9583e8 (patch)
tree08271fc12e0a8da25fb0ec313772109c0bdf193a
parent459d99c44c7df4cd09d82fa54c53e5d5eec47a4e (diff)
downloadorg-mode-2db83d6a39c0dbffb70b58e9dce8e2bddf9583e8.tar.gz
Moved tests into testing/ directory
-rw-r--r--testing/org-html/tests.el499
1 files changed, 499 insertions, 0 deletions
diff --git a/testing/org-html/tests.el b/testing/org-html/tests.el
new file mode 100644
index 0000000..1dfa0d8
--- /dev/null
+++ b/testing/org-html/tests.el
@@ -0,0 +1,499 @@
+;;;_ org-html/tests.el --- Tests for org-html
+
+;;;_. Headers
+;;;_ , License
+;; Copyright (C) 2010 Tom Breton (Tehom)
+
+;; Author: Tom Breton (Tehom) <tehom@panix.com>
+;; Keywords: lisp, maint, internal
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;_ , Commentary:
+
+;;
+
+
+;;;_ , Requires
+
+(require 'org-html)
+
+;;;_. Body
+;;;_ , org-id testhelp
+;;This would go into org-id/testhelp.el if there were such a file
+(defconst org-id:thd:usual-id-locations
+ (org-id-alist-to-hash
+ '(
+ ("file1" "id-1-in-file1")
+ ("file1" "id-2-in-file1")
+ ("file2" "id-1-in-file2")))
+
+ "A stable id-locations table for testing purposes" )
+;;;_ . Validation
+(emt:deftest-3 org-id:thd:usual-id-locations
+ (nil
+ (progn
+ (emt:doc "Operation: Look up one of the keys we inserted.")
+ (emt:doc "Response: It has the value we gave it.")
+ (assert
+ (equal
+ (gethash "id-1-in-file1" org-id:thd:usual-id-locations)
+ "file1")))))
+
+;;;_ , Config
+;;;_ . org-html:thd:isolation
+(defconst org-html:thd:isolation
+ ;;Can't hope to capture all the org configuration any time soon,
+ ;;but let's set it up to some degree.
+
+ ;;It is generally better for this to remain constant than to try to
+ ;;sync this with new versions. To change it is effectively to
+ ;;write new tests.
+ '(let
+ (
+ (org-export-html-inline-image-extensions
+ '("png" "jpeg" "jpg" "gif"))
+ (org-html-cvt-link-fn nil)
+ (org-export-first-hook nil)
+ (org-par-open t)
+ (org-url-encoding-use-url-hexify nil)
+
+ ;;To control the org-id lookups
+ (org-id-locations
+ org-id:thd:usual-id-locations)
+
+ ;;To control `org-default-export-plist'
+ (org-export-inbuffer-options-extra nil)
+
+ ;;To control `org-infile-export-plist'. Set up for minimal
+ ;;export so we can more easily handle examples. When
+ ;;specific behavior is to be tested, locally bind the
+ ;;controlling variable(s), don't change them here.
+ (org-export-html-link-up "")
+ (org-export-html-link-home "")
+ (org-export-default-language "en")
+ (org-export-page-keywords "")
+ (org-export-page-description "")
+ (org-display-custom-times nil)
+ (org-export-headline-levels 100)
+ (org-export-with-section-numbers nil)
+ (org-export-section-number-format '((("1" ".")) . ""))
+ (org-export-with-toc nil)
+ (org-export-preserve-breaks nil)
+ (org-export-with-archived-trees nil)
+ (org-export-with-emphasize nil)
+ (org-export-with-sub-superscripts nil)
+ (org-export-with-special-strings nil)
+ (org-export-with-footnotes nil)
+ (org-export-with-drawers nil)
+ (org-export-with-tags nil)
+ (org-export-with-todo-keywords nil)
+ (org-export-with-priority nil)
+ (org-export-with-TeX-macros nil)
+ (org-export-with-LaTeX-fragments nil)
+ (org-export-latex-listings nil)
+ (org-export-skip-text-before-1st-heading nil)
+ (org-export-with-fixed-width nil)
+ (org-export-with-timestamps nil)
+ (org-export-author-info nil)
+ (org-export-email-info nil)
+ (org-export-creator-info nil)
+ (org-export-time-stamp-file nil)
+ (org-export-with-tables nil)
+ (org-export-highlight-first-table-line nil)
+ (org-export-html-style-include-default nil)
+ (org-export-html-style-include-scripts nil)
+ (org-export-html-style "")
+ (org-export-html-style-extra "")
+ (org-agenda-export-html-style "")
+ (org-export-html-link-org-files-as-html nil)
+ (org-export-html-inline-images nil)
+ (org-export-html-extension "html")
+ (org-export-html-xml-declaration
+ '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
+ ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>")))
+ (org-export-html-table-tag
+ "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">")
+ (org-export-html-expand nil)
+ (org-export-html-with-timestamp nil)
+ (org-export-publishing-directory nil)
+ (org-export-html-preamble nil)
+ (org-export-html-postamble nil)
+ (org-export-html-auto-preamble nil)
+ (org-export-html-auto-postamble nil)
+ (user-full-name "Emtest user")
+ (user-mail-address "emtest-user@localhost.localdomain")
+ (org-export-select-tags '("export"))
+ (org-export-exclude-tags '("noexport"))
+ (org-export-latex-image-default-option nil)
+
+ (org-export-plist-vars
+ '(
+ (:link-up nil org-export-html-link-up)
+ (:link-home nil org-export-html-link-home)
+ (:language nil org-export-default-language)
+ (:keywords nil org-export-page-keywords)
+ (:description nil org-export-page-description)
+ (:customtime nil org-display-custom-times)
+ (:headline-levels "H" org-export-headline-levels)
+ (:section-numbers "num" org-export-with-section-numbers)
+ (:section-number-format nil org-export-section-number-format)
+ (:table-of-contents "toc" org-export-with-toc)
+ (:preserve-breaks "\\n" org-export-preserve-breaks)
+ (:archived-trees nil org-export-with-archived-trees)
+ (:emphasize "*" org-export-with-emphasize)
+ (:sub-superscript "^" org-export-with-sub-superscripts)
+ (:special-strings "-" org-export-with-special-strings)
+ (:footnotes "f" org-export-with-footnotes)
+ (:drawers "d" org-export-with-drawers)
+ (:tags "tags" org-export-with-tags)
+ (:todo-keywords "todo" org-export-with-todo-keywords)
+ (:priority "pri" org-export-with-priority)
+ (:TeX-macros "TeX" org-export-with-TeX-macros)
+ (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments)
+ (:latex-listings nil org-export-latex-listings)
+ (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading)
+ (:fixed-width ":" org-export-with-fixed-width)
+ (:timestamps "<" org-export-with-timestamps)
+ (:author-info "author" org-export-author-info)
+ (:email-info "email" org-export-email-info)
+ (:creator-info "creator" org-export-creator-info)
+ (:time-stamp-file "timestamp" org-export-time-stamp-file)
+ (:tables "|" org-export-with-tables)
+ (:table-auto-headline nil org-export-highlight-first-table-line)
+ (:style-include-default nil org-export-html-style-include-default)
+ (:style-include-scripts nil org-export-html-style-include-scripts)
+ (:style nil org-export-html-style)
+ (:style-extra nil org-export-html-style-extra)
+ (:agenda-style nil org-agenda-export-html-style)
+ (:convert-org-links nil org-export-html-link-org-files-as-html)
+ (:inline-images nil org-export-html-inline-images)
+ (:html-extension nil org-export-html-extension)
+ (:xml-declaration nil org-export-html-xml-declaration)
+ (:html-table-tag nil org-export-html-table-tag)
+ (:expand-quoted-html "@" org-export-html-expand)
+ (:timestamp nil org-export-html-with-timestamp)
+ (:publishing-directory nil org-export-publishing-directory)
+ (:preamble nil org-export-html-preamble)
+ (:postamble nil org-export-html-postamble)
+ (:auto-preamble nil org-export-html-auto-preamble)
+ (:auto-postamble nil org-export-html-auto-postamble)
+ (:author nil user-full-name)
+ (:email nil user-mail-address)
+ (:select-tags nil org-export-select-tags)
+ (:exclude-tags nil org-export-exclude-tags)
+ (:latex-image-options nil org-export-latex-image-default-option)))
+ ))
+ "Isolation let-form for org-html tests.
+
+Isolation let-forms are intended to be included by
+`:surrounders'. They provide a known configuration and keep
+tests from altering the outside state." )
+
+;;;_ , Examples
+(defconst org-html:thd:examples
+ (emt:eg:define+ ;;xmp:tqu804919ze0
+ ((project org)
+ (library html)
+ (subsection link-examples))
+ (group
+ ((name only-path))
+ ;;No src-text because this arglist wouldn't be generated by
+ ;;org-export-as-html, though it might be created by custom link
+ ;;types.
+ (item ((type arglist))
+ '("" "foo" nil "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"foo\">desc</a>"))
+ (group
+ ((name only-fragment))
+ ;;No src-text, same reason
+ (item ((type arglist))
+ '("" "" "bar" "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"#bar\">desc</a>"))
+ (group
+ ((name all-3-parts))
+ (item ((type src-text))
+ "[[http:foo#bar][desc]]")
+ (item ((type arglist))
+ '("http" "foo" "bar" "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"http:foo#bar\">desc</a>"))
+
+ ;;Filename has to be absolute to trigger substitution.
+ (group
+ ((name subst-in-filename))
+ (item ((type src-text))
+ "[[file:/foo/unfoo/.././baz][desc]]")
+ (item ((type arglist))
+ '("file" "/foo/unfoo/.././baz" "" "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"file:/foo/baz\">desc</a>"))
+
+ (group
+ ((name type=file))
+ (item ((type src-text))
+ "[[file:foo.txt][desc]]")
+ (item ((type arglist))
+ '("file" "foo.txt" "" "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"file:foo.txt\">desc</a>"))
+
+ ;;We control what location id finds by controlling
+ ;;`org-id-locations' in `org-html:thd:isolation'
+ (group
+ ((name type=id))
+ (item ((type src-text))
+ "[[id:id-1-in-file1][desc]]")
+ (item ((type arglist))
+ '("" "file1" "id-1-in-file1" "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"file1#id-1-in-file1\">desc</a>"))
+ (group
+ ((name type=ftp))
+ (item ((type src-text))
+ "[[ftp:foo.com][desc]]")
+ (item ((type arglist))
+ '("ftp" "foo.com" "" "desc" nil nil))
+ (item ((type link-text))
+ "<a href=\"ftp:foo.com\">desc</a>"))
+
+ ;;Punt coderef, internal logic is too hairy, would have to control
+ ;;`org-export-get-coderef-format'.
+
+ ;;Punt custom links, would have to make a controlled
+ ;;`org-link-protocols', which means identifying and binding every
+ ;;variable that `org-add-link-type' alters, then binding
+ ;;`org-link-protocols' to empty list, then calling
+ ;;`org-add-link-type' (possibly for id as well)
+
+ (group
+ ((name convertable))
+ (item ((type src-text))
+ "[[file:foo.org][desc]]")
+ (item ((type arglist))
+ '("file" "foo.org" nil "desc" nil nil))
+ (group
+ ((type link-text))
+ (item ((subname old-conversion))
+ "<a href=\"http:foo.html\">desc</a>")
+ (item ((subname new-conversion))
+ "<a href=\"xform:transformed-foo.org\">desc</a>")
+ (item ((subname no-conversion))
+ "<a href=\"file:foo.org\">desc</a>")))
+ ))
+
+;;;_ , Helpers
+
+(defun org-html:th:cvt-fn (opt-plist type path)
+ "Trivial URL transformer"
+ (declare (ignored opt-plist))
+ (list
+ "xform"
+ (concat "transformed-" path)))
+
+(defun org-html:th:check-link-matches (expected)
+ "Build a link text and check it against expected text.
+Sensitive to emt:eg narrowing."
+
+ (assert
+ (equal
+ (apply #'org-html-make-link
+ '(:html-extension "html")
+ (emt:eg (type arglist)))
+ expected)
+ t))
+
+
+;;;_ , org-html-make-link
+(emt:deftest-3
+ ((of 'org-html-make-link)
+ (:surrounders
+ (list
+ org-html:thd:isolation
+ '(emt:eg:with org-html:thd:examples
+ ((project org)
+ (library html)
+ (subsection link-examples))))))
+
+ (nil
+ (emt:eg:map name name
+ (unless
+ (eq name 'convertable)
+ (emt:doc "Proves: Example arglist gives the expected result.")
+ (org-html:th:check-link-matches
+ (emt:eg (type link-text))))))
+
+ (nil
+ (emt:eg:narrow ((name convertable))
+ (let
+ (
+ (org-export-html-link-org-files-as-html t)
+ (org-html-cvt-link-fn nil))
+ (emt:doc "Proves: Old org->html conversion works.")
+ (org-html:th:check-link-matches
+ (emt:eg (type link-text) (subname old-conversion))))))
+
+ (nil
+ (emt:eg:narrow ((name convertable))
+ (let
+ (
+ (org-export-html-link-org-files-as-html nil)
+ (org-html-cvt-link-fn #'org-html:th:cvt-fn))
+ (emt:doc "Proves: New file->url conversion works.")
+ (org-html:th:check-link-matches
+ (emt:eg (type link-text) (subname new-conversion))))))
+
+ (nil
+ (emt:eg:narrow ((name convertable))
+ (let
+ (
+ (org-export-html-link-org-files-as-html t)
+ (org-html-cvt-link-fn #'org-html:th:cvt-fn))
+ (emt:doc "Proves: New conversion has precedence over old.")
+ (org-html:th:check-link-matches
+ (emt:eg (type link-text) (subname new-conversion))))))
+
+
+
+ ;;Add tests for making images - but it's nearly direct.
+
+ )
+;;;_ , Helpers
+(defun org-html:th:build-source (type path fragment &optional desc
+ descp attr may-inline-p)
+ ""
+ (declare (ignored descp attr may-inline-p))
+ (concat
+ "[["type":"
+ (org-link-escape path)
+ (if fragment
+ (cond
+ ((string= type "file")(concat "::" fragment))
+ ((string= type "http")(concat "#" fragment))))
+ "]["desc"]]"))
+;;;_ . org-html:th:strip-whitepadding
+(defun org-html:th:strip-whitepadding (str)
+ ""
+
+ (with-temp-buffer
+ (insert str)
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (search-forward "<p>" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (search-forward "</p>" nil t)
+ (replace-match ""))
+ (buffer-string)))
+;;;_ , Examples
+(defconst org-html:stripwhite:thd:examples
+ (emt:eg:define+ ;;xmp:khpjmfi0aze0
+ ((project org)(library html)
+ (subsection org-html:th:strip-whitepadding)
+ (type string)
+ (role before))
+ (item ((name 0))
+ "\na\nb")
+ (item ((name 1))
+ "\n<p>ab")
+ (item ((name 2))
+ "\n</p>a\nb")))
+
+;;;_ , Tests
+(emt:deftest-3 org-html:th:strip-whitepadding
+ (nil
+ (emt:eg:with org-html:stripwhite:thd:examples
+ ((project org)(library html)
+ (subsection org-html:th:strip-whitepadding))
+ (emt:eg:map name name
+ (emt:doc
+ "Check: The stripped string matches what's expected.")
+ (assert
+ (string=
+ (org-html:th:strip-whitepadding (emt:eg))
+ "ab"))))))
+
+;;;_ , org-export-as-html
+
+(emt:deftest-3
+ ((of 'org-export-as-html)
+ (:surrounders
+ (list
+ org-html:thd:isolation
+ ;;Re-use the link examples.
+ '(emt:eg:with org-html:thd:examples
+ ((project org)(library html))))))
+ (nil
+ (emt:eg:narrow ((subsection link-examples))
+ (emt:eg:map name name
+ (when
+ (and
+ (not (eq name 'convertable))
+ ;;Dormant for id because it wants to find filename
+ ;;relative to `org-current-export-file', but for
+ ;;buffer export there is none.
+ (not (eq name 'type=id))
+ (emt:eg:boundp '(type src-text)))
+ (emt:doc
+ "Situation: the only thing in the buffer is that link")
+ (with-buffer-containing-object
+ (:string
+ (emt:eg (type src-text)))
+ (org-mode)
+
+ ;;This calculation has to be done outside the assert
+ ;;or it will be done twice.
+ (emt:doc "Operation: export the buffer as HTML.")
+ (let
+ ((result
+ (org-html:th:strip-whitepadding
+ (org-export-region-as-html
+ (point-min)
+ (point-max)
+ t
+ 'string))))
+ (emt:doc
+ "Proves: Example arglist gives the expected result.")
+ (assert
+ (string=
+ result
+ (emt:eg (type link-text)))
+ t)))))))
+ ;;Could also use testpoints to test that we feed the link-builder
+ ;;functions as expected.
+
+
+ ;;Could also make example files and convert them.
+ )
+
+
+
+;;;_. Footers
+;;;_ , Provides
+
+(provide 'org-html/tests)
+
+;;;_ * Local emacs vars.
+;;;_ + Local variables:
+;;;_ + mode: allout
+;;;_ + End:
+
+;;;_ , End
+;;; org-html/tests.el ends here