From 91d488571bf796b61d275def376603975f127fde Mon Sep 17 00:00:00 2001
From: Holger Dürer <me@hdurer.net>
Date: Wed, 10 May 2017 21:26:43 +0100
Subject: Add tests for mastodon-media.el
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This also includes tweaks to make Travis happy — tests previously did pass on my laptop but Travis's environment is different.
---
lisp/mastodon-media.el | 23 +++---
test/mastodon-media-tests.el | 179 +++++++++++++++++++++++++++++++++++++++++++
test/mastodon-tl-tests.el | 2 +
3 files changed, 195 insertions(+), 9 deletions(-)
create mode 100644 test/mastodon-media-tests.el
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))
--
cgit v1.2.3