feat: tests

doerg/src/net/deertopia/doerg/render.clj

@@ -156,7 +156,7 @@
   ;;     vertical-align in the style attribute
   ;;   • Viewbox: Must be removed entirely for correct positioning.
   (-> (slurp file)
-      (str/replace-first "<?xml version='1.0' encoding='UTF-8'?>" "")
+      (str/replace-first #"<\?xml version='1.0' encoding='UTF-8'\?>\n?" "")
       (str/replace-first #" height=['\"][^\"']+[\"']" "")
       (str/replace-first #" width=['\"][^\"']+[\"']" "")
       (str/replace-first
@@ -167,7 +167,10 @@
                  (format "height:%.4fem;vertical-align:%.4fem;display:inline-block"
                          height (- depth)))))))
 
-(defn- render-tex-snippets [doc]
+(defn render-tex-snippets
+  "Traverse doc, adorning each LaTeX node with a promise resolving to,
+  optimistically, Hiccup-rendered SVG or MathML code."
+  [doc]
   (let [promises (atom [])
         r (->> doc (sp/transform
                     [element/postorder-walker
@@ -196,13 +199,20 @@
                                     (deliver promise))))
                            (deliver promise (hiccup/raw temml))))
                        (catch Exception e
-                         (prn e)
-                         (flush)
+                         (lr/error e)
                          (throw e))))
                 (when (fs/exists? "/tmp/doerg-svgs")
                   (fs/delete-tree "/tmp/doerg-svgs"))
-                (fs/copy-tree svg-dir "/tmp/doerg-svgs"))))]
-    (future-call (bound-fn* f))
+                (fs/copy-tree svg-dir "/tmp/doerg-svgs"))))
+        fut (future-call (bound-fn* f))]
+    ;; Time out after eight seconds. With all the LaTeX and IPC, there
+    ;; are so many opportunities for things to go wrong </3.
+    (let [fut-res (deref fut (* 10 1000) ::timed-out)]
+      (if (= fut-res ::timed-out)
+        (do (future-cancel fut)
+            (doseq [{:keys [promise]} @promises]
+              (deliver promise ::timed-out)))
+        fut-res))
     r))
 
 (comment
@@ -352,11 +362,11 @@
 
 (defmethod org-element "latex-fragment" [{:keys [contents value] :as e}]
   [:span.latex-fragment
-   (-> e ::rendered (deref #_#_ 2000 "«timed out»"))])
+   (-> e ::rendered deref)])
 
 (defmethod org-element "latex-environment" [{:keys [value] :as e}]
   [:span.latex-fragment
-   (-> e ::rendered (deref #_#_ 2000 "«timed out»"))])
+   (-> e ::rendered deref)])
 
 (defmethod org-element "example-block" [{:keys [value]}]
   [:pre value])

doerg/src/net/deertopia/doerg/repl.clj

@@ -18,7 +18,7 @@
   "/home/msyds/org/20250512144715-natural_transformation_category_theory.org"
   #_
   "/home/msyds/org/20251021155921-path_action.org"
-  "test/net/deertopia/doerg/tex-test.org")
+  "test/net/deertopia/doerg/render_test/fallbacks.org")
 
 (defn- force-create-sym-link [path target]
   (fs/delete-if-exists path)

doerg/test/net/deertopia/doerg/render_test.clj

@@ -1,2 +1,60 @@
 (ns net.deertopia.doerg.render-test
-  (:require [net.deertopia.doerg.render :as sut]))
+  (:require [net.deertopia.doerg.render :as sut]
+            [net.deertopia.doerg.element :as element]
+            [net.deertopia.doerg.tex.temml :as temml]
+            [net.deertopia.doerg.tex.native :as native]
+            [com.rpl.specter :as sp]
+            [clojure.edn :as edn]
+            [clojure.test :as t]
+            [clojure.java.io :as io]
+            [clojure.string :as str]))
+
+;; Stupid and hacky.
+(defn mathml? [s]
+  (str/starts-with? s "<math"))
+
+;; Also stupid and hacky. }:)
+(defn svg? [s]
+  (some? (re-matches #"(?s)(<!--.*?-->\n)<svg.*" s)))
+
+(defn read-resource [s]
+  (let [p (-> (format "net/deertopia/doerg/render_test/%s" s)
+              io/resource slurp)]
+    (cond (str/ends-with? s ".edn") (edn/read-string p)
+          (str/ends-with? s ".org") (element/read-string p))))
+
+(t/deftest latex-fallbacks
+  (t/testing "LaTeX fallback behaviour"
+    (let [doc (temml/binding-worker
+                (-> "fallbacks.org" read-resource sut/render-tex-snippets))
+          snippets (->> doc
+                        (sp/select
+                         [element/postorder-walker
+                          #(element/of-type?
+                            % "latex-fragment" "latex-environment")
+                          (sp/view #(-> % ::sut/rendered deref str))]))
+          expectations (-> "fallbacks.edn" read-resource)]
+      (doall (map (fn [s e]
+                    (let [mathml (mathml? s)
+                          svg (svg? s)]
+                      (assert
+                       (not= mathml svg)
+                       "`mathml?` and `svg?` should be mutually-exclusive.")
+                      (case e
+                        :mathml (t/is mathml)
+                        :svg (t/is svg))))
+                  snippets expectations)))))
+
+(t/deftest latex-laziness
+  (t/testing "LaTeX laziness"
+    (let [ex (Exception. "you're supposed to be lazy!")
+          bad (fn [& _] (throw ex))
+          doc (read-resource "latexless.org")
+          r (try (with-redefs-fn {#'native/render bad
+                                  #'temml/render bad}
+                   #(sut/render-tex-snippets doc))
+                 (catch Exception e
+                   (if (= e ex)
+                     false
+                     (throw e))))]
+      (t/is r))))

doerg/test/net/deertopia/doerg/render_test/fallbacks.edn

@@ -0,0 +1,7 @@
+[:mathml
+ :mathml
+ :mathml
+ :mathml
+ :svg
+ :mathml
+ :svg]

doerg/test/net/deertopia/doerg/render_test/latexless.org

@@ -0,0 +1,3 @@
+#+title: 이 파일은 LaTeX 코드가 포함되지 않습니다.
+
+🦌!