;;;_ 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