Add tests for mastodon-media.el

This also includes tweaks to make Travis happy — tests previously did pass on my laptop but Travis's environment is different.

3 files changed, 195 insertions, 9 deletions

diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 734e11f..d1ec871 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -1,4 +1,4 @@
-;;; mastodon-media.el --- Functions for inlining Mastodon media  -*- lexical-binding: t -*-
+;;; mastodon-media.el --- Functions for inlining Mastodon media
 
 ;; Copyright (C) 2017 Johnson Denen
 ;; Author: Johnson Denen <johnson.denen@gmail.com>
@@ -161,9 +161,11 @@ IMAGE-URL is the URL that was retrieved.
 MEDIA-TYPE is a symbol and either 'avatar or 'media-link."
   ;; TODO: Cache the avatars
   (let ((image-options (when (image-type-available-p 'imagemagick)
-                         (pcase media-type
-                           ('avatar `(:height ,mastodon-avatar-height))
-                           ('media-link `(:max-height ,mastodon-preview-max-height))))))
+                         (cond
+                          ((eq media-type 'avatar)
+                           `(:height ,mastodon-avatar-height))
+                          ((eq media-type 'media-link)
+                           `(:max-height ,mastodon-preview-max-height))))))
     (url-retrieve url
                   #'mastodon-media--process-image-response
                   (list (copy-marker start) image-options region-length url))))
@@ -182,11 +184,14 @@ found."
       ;; do nothing - the loop will proceed
       )
     (when next-pos
-      (pcase (get-text-property next-pos 'media-type)
-        ;; Avatars are just one character in the buffer
-        ('avatar (list next-pos (+ next-pos 1) 'avatar))
+      (let ((media-type (get-text-property next-pos 'media-type)))
+        (cond
+         ;; Avatars are just one character in the buffer
+         ((eq media-type 'avatar)
+          (list next-pos (+ next-pos 1) 'avatar))
         ;; Media links are 5 character ("[img]")
-        ('media-link (list next-pos (+ next-pos 5) 'media-link))))))
+         ((eq media-type 'media-link)
+          (list next-pos (+ next-pos 5) 'media-link)))))))
 
 (defun mastodon-media--valid-link-p (link)
   "Checks to make sure that the missing string has
@@ -204,7 +209,7 @@ not been returned."
     (while (setq line-details (mastodon-media--select-next-media-line))
       (let* ((start (car line-details))
              (end (cadr line-details))
-             (media-type (caddr line-details))
+             (media-type (cadr (cdr line-details)))
              (image-url (get-text-property start 'media-url)))
         (if (not (mastodon-media--valid-link-p image-url))
             ;; mark it at least as not needing loading any more
diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el
new file mode 100644
index 0000000..9cd06b7
--- /dev/null
+++ b/test/mastodon-media-tests.el
@@ -0,0 +1,179 @@
+(require 'el-mock)
+
+(ert-deftest mastodon-media:get-avatar-rendering ()
+  "Should return text with all expected properties."
+  (with-mock
+    (mock (image-type-available-p 'imagemagick) => t)
+    (mock (create-image * 'imagemagick t :height 123) => :mock-image)
+
+    (let* ((mastodon-avatar-height 123)
+           (result (mastodon-media--get-avatar-rendering "http://example.org/img.png"))
+           (result-no-properties (substring-no-properties result))
+           (properties (text-properties-at 0 result)))
+      (should (string= "  " result-no-properties))
+      (should (string= "http://example.org/img.png" (plist-get properties 'media-url)))
+      (should (eq 'needs-loading (plist-get properties 'media-state)))
+      (should (eq 'avatar (plist-get properties 'media-type)))
+      (should (eq :mock-image (plist-get properties 'display))))))
+
+(ert-deftest mastodon-media:get-media-link-rendering ()
+  "Should return text with all expected properties."
+  (with-mock
+    (mock (create-image * nil t) => :mock-image)
+
+    (let* ((mastodon-preview-max-height 123)
+           (result (mastodon-media--get-media-link-rendering "http://example.org/img.png"))
+           (result-no-properties (substring-no-properties result))
+           (properties (text-properties-at 0 result)))
+      (should (string= "[img] " result-no-properties))
+      (should (string= "http://example.org/img.png" (plist-get properties 'media-url)))
+      (should (eq 'needs-loading (plist-get properties 'media-state)))
+      (should (eq 'media-link (plist-get properties 'media-type)))
+      (should (eq :mock-image (plist-get properties 'display))))))
+
+(ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic ()
+  "Should make the right call to url-retrieve."
+  (let ((url "http://example.org/image.png")
+        (mastodon-avatar-height 123))
+    (with-mock
+      (mock (image-type-available-p 'imagemagick) => t)
+      (mock (create-image * 'imagemagick t :height 123) => '(image foo))
+      (mock (copy-marker 7) => :my-marker )
+      (mock (url-retrieve
+             url
+             #'mastodon-media--process-image-response
+             '(:my-marker (:height 123) 1 "http://example.org/image.png"))
+            => :called-as-expected)
+
+      (with-temp-buffer
+        (insert (concat "Start:"
+                        (mastodon-media--get-avatar-rendering "http://example.org/img.png")
+                        ":rest"))
+
+        (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1)))))))
+
+(ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic ()
+  "Should make the right call to url-retrieve."
+  (let ((url "http://example.org/image.png"))
+    (with-mock
+      (mock (image-type-available-p 'imagemagick) => nil)
+      (mock (create-image * nil t) => '(image foo))
+      (mock (copy-marker 7) => :my-marker )
+      (mock (url-retrieve
+             url
+             #'mastodon-media--process-image-response
+             '(:my-marker () 1 "http://example.org/image.png"))
+            => :called-as-expected)
+
+      (with-temp-buffer
+        (insert (concat "Start:"
+                        (mastodon-media--get-avatar-rendering "http://example.org/img.png")
+                        ":rest"))
+
+        (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1)))))))
+
+(ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic ()
+  "Should make the right call to url-retrieve."
+  (let ((url "http://example.org/image.png"))
+    (with-mock
+      (mock (image-type-available-p 'imagemagick) => t)
+      (mock (create-image * nil t) => '(image foo))
+      (mock (copy-marker 7) => :my-marker )
+      (mock (url-retrieve
+             "http://example.org/image.png"
+             #'mastodon-media--process-image-response
+             '(:my-marker (:max-height 321) 5 "http://example.org/image.png"))
+            => :called-as-expected)
+      (with-temp-buffer
+        (insert (concat "Start:"
+                        (mastodon-media--get-media-link-rendering url)
+                        ":rest"))
+        (let ((mastodon-preview-max-height 321))
+          (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5))))))))
+
+(ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic ()
+  "Should make the right call to url-retrieve."
+  (let ((url "http://example.org/image.png"))
+    (with-mock
+      (mock (image-type-available-p 'imagemagick) => nil)
+      (mock (create-image * nil t) => '(image foo))
+      (mock (copy-marker 7) => :my-marker )
+      (mock (url-retrieve
+             "http://example.org/image.png"
+             #'mastodon-media--process-image-response
+             '(:my-marker () 5 "http://example.org/image.png"))
+            => :called-as-expected)
+
+      (with-temp-buffer
+        (insert (concat "Start:"
+                        (mastodon-media--get-avatar-rendering url)
+                        ":rest"))
+        (let ((mastodon-preview-max-height 321))
+          (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5))))))))
+
+(ert-deftest mastodon-media:process-image-response ()
+  "Should process the HTTP response and adjust the source buffer."
+  (with-temp-buffer
+    (with-mock
+      (let ((source-buffer (current-buffer))
+           used-marker
+           saved-marker)
+       (insert "start:")
+       (setq used-marker (copy-marker (point))
+             saved-marker (copy-marker (point)))
+       ;; Mock needed for the preliminary image created in mastodon-media--get-avatar-rendering
+       (stub create-image => :fake-image)
+       (insert (mastodon-media--get-avatar-rendering "http://example.org/image.png")
+               ":end")
+       (with-temp-buffer
+         (insert "some irrelevant\n"
+                 "http headers\n"
+                 "which will be ignored\n\n"
+                 "fake\nimage\ndata")
+         (goto-char (point-min))
+
+         (mock (create-image "fake\nimage\ndata" 'imagemagick t ':image :option) => :fake-image)
+
+         (mastodon-media--process-image-response () used-marker '(:image :option) 1 "the-url")
+
+         ;; the used marker has been unset:
+         (should (null (marker-position used-marker)))
+         ;; the media-state has been set to loaded and the image is being displayed
+         (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer)))
+         (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer))))))))
+
+(ert-deftest mastodon-media:inline-images ()
+  "Should process all media in buffer."
+  (with-mock
+    ;; Stub needed for the test setup:
+    (stub create-image => '(image ignored))
+
+    (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar)
+      (with-temp-buffer
+        (insert "Some text before\n")
+        (setq marker-media-link (copy-marker (point)))
+        (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg")
+                " some more text ")
+        (setq marker-media-link-bad-url (copy-marker (point)))
+        (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png")
+                " some more text ")
+        (setq marker-false-media (copy-marker (point)))
+        (insert
+         ;; text that looks almost like an avatar but lacks the media-url property
+         (propertize "this won't be processed"
+                     'media-state 'needs-loading
+                     'media-type 'avatar)
+         "even more text ")
+        (setq marker-avatar (copy-marker (point)))
+        (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png")
+                " end of text")
+        (goto-char (point-min))
+
+        ;; stub for the actual test:
+        (stub mastodon-media--load-image-from-url)
+        (mastodon-media--inline-images)
+
+        (should (eq 'loading (get-text-property marker-media-link 'media-state)))
+        (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state)))
+        (should (eq 'loading (get-text-property marker-avatar 'media-state)))
+        (should (eq 'needs-loading (get-text-property marker-false-media 'media-state)))))))
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index 0d0458d..a91d6d5 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -122,6 +122,7 @@
   (let ((mastodon-media-show-avatars-p t)
         (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot))))
     (with-mock
+      (stub create-image => '(image "fake data"))
       (mock (date-to-time timestamp) => '(22782 21551))
       (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22")
 
@@ -204,6 +205,7 @@
     (with-mock
       ;; We don't expect to use the toot's timestamp but the timestamp of the
       ;; reblogged toot:
+      (stub create-image => '(image "fake data"))
       (mock (date-to-time timestamp) => '(1 2))
       (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time")
       (mock (date-to-time original-timestamp) => '(3 4))