diff --git a/testing/org-html/tests.el b/testing/org-html/tests.el new file mode 100644 index 000000000..1dfa0d8ab --- /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) +;; 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" . "") + ("php" . "\"; ?>"))) + (org-export-html-table-tag + "") + (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)) + "desc")) + (group + ((name only-fragment)) + ;;No src-text, same reason + (item ((type arglist)) + '("" "" "bar" "desc" nil nil)) + (item ((type link-text)) + "desc")) + (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)) + "desc")) + + ;;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)) + "desc")) + + (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)) + "desc")) + + ;;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)) + "desc")) + (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)) + "desc")) + + ;;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)) + "desc") + (item ((subname new-conversion)) + "desc") + (item ((subname no-conversion)) + "desc"))) + )) + +;;;_ , 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 "

" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (search-forward "

" 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

ab") + (item ((name 2)) + "\n

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