aboutsummaryrefslogtreecommitdiff
path: root/test/mastodon-tl-tests.el
diff options
context:
space:
mode:
authorHolger Dürer <me@hdurer.net>2017-05-20 20:00:24 +0100
committerHolger Dürer <me@hdurer.net>2017-06-19 17:16:29 +0100
commit746694f0ea75f5fa76739d49509836ccd67d7d65 (patch)
treed52459be2372625060b6de7339aac0a526c00d3a /test/mastodon-tl-tests.el
parent20e3b77a9a37373754d0adedcee2ede6cf1f5922 (diff)
Add periodic updating of the timestamp displays.
For each buffer we add a timer that periodically checks all timestamps and updates them as needed. The logic tries to be smart and - only schedule an update when at least one timestamps display needs changing (although at the moment we update at least every 5 minutes), and - only do a limited amount of work in each timer callback so as to not block Emacs's interactive work.
Diffstat (limited to 'test/mastodon-tl-tests.el')
-rw-r--r--test/mastodon-tl-tests.el294
1 files changed, 290 insertions, 4 deletions
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index ed16b1b..8c7dc4c 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -112,8 +112,8 @@
(weeks (n) (* n (days 7)))
(years (n) (* n (days 365)))
(format-seconds-since (seconds)
- (let ((time-stamp (time-subtract (current-time) (seconds-to-time seconds))))
- (mastodon-tl--relative-time-description time-stamp)))
+ (let ((timestamp (time-subtract (current-time) (seconds-to-time seconds))))
+ (mastodon-tl--relative-time-description timestamp)))
(check (seconds expected)
(should (string= (format-seconds-since seconds) expected))))
(check 1 "less than a minute ago")
@@ -136,12 +136,74 @@
(check (days 6.6) "one week ago") ;; rounding up
(check (weeks 2.49) "2 weeks ago") ;; rounding down
(check (weeks 2.51) "3 weeks ago") ;; rounding down
- (check (weeks 52) "52 weeks ago")
- (check (weeks 53) "one year ago")
+ (check (1- (weeks 52)) "52 weeks ago")
+ (check (weeks 52) "one year ago")
(check (years 2.49) "2 years ago") ;; rounding down
(check (years 2.51) "3 years ago") ;; rounding down
))
+(ert-deftest mastodon-tl--relative-time-details--next-update ()
+ "Should calculate the next update time information as expected"
+ (let ((current-time (current-time)))
+ (cl-labels ((minutes (n) (* n 60))
+ (hours (n) (* n (minutes 60)))
+ (days (n) (* n (hours 24)))
+ (weeks (n) (* n (days 7)))
+ (years (n) (* n (days 365.25)))
+ (next-update (seconds-ago)
+ (let* ((timestamp (time-subtract current-time
+ (seconds-to-time seconds-ago))))
+ (cdr (mastodon-tl--relative-time-details timestamp current-time))))
+ (check (seconds-ago)
+ (let* ((timestamp (time-subtract current-time (seconds-to-time seconds-ago)))
+ (at-now (mastodon-tl--relative-time-description timestamp current-time))
+ (at-one-second-before (mastodon-tl--relative-time-description
+ timestamp
+ (time-subtract (next-update seconds-ago)
+ (seconds-to-time 1))))
+ (at-result (mastodon-tl--relative-time-description
+ timestamp
+ (next-update seconds-ago))))
+ (when nil ;; change to t to debug test failures
+ (prin1 (format "\nFor %s: %s / %s"
+ seconds-ago
+ (time-to-seconds
+ (time-subtract (next-update seconds-ago)
+ timestamp))
+ (round
+ (time-to-seconds
+ (time-subtract (next-update seconds-ago)
+ current-time))))))
+ ;; a second earlier the description is the same as at current time
+ (should (string= at-now at-one-second-before))
+ ;; but at the result time it is different
+ (should-not (string= at-one-second-before at-result)))))
+ (check 0)
+ (check 1)
+ (check 59)
+ (check 60)
+ (check 89)
+ (check 90)
+ (check 149)
+ (check 150)
+ (check (1- (hours 1.5))) ;; just before we switch from "one hour" to "2 hours"
+ (check (hours 1.5))
+ (check (hours 2.1))
+ (check (1- (hours 23.5))) ;; just before "23 hours" -> "one day"
+ (check (hours 23.5))
+ (check (1- (days 1.5))) ;; just before "one day" -> "2 days"
+ (check (days 1.5)) ;; just before "one day" -> "2 days"
+ (check (days 2.1))
+ (check (1- (days 6.5))) ;; just before "6 days" -> "one week"
+ (check (days 6.5)) ;; "one week" -> "2 weeks"
+ (check (weeks 2.1))
+ (check (1- (weeks 52))) ;; just before "52 weeks" -> "one year"
+ (check (weeks 52))
+ (check (days 365))
+ (check (days 366))
+ (check (years 2.1))
+ )))
+
(ert-deftest mastodon-tl--byline-regular ()
"Should format the regular toot correctly."
(let ((mastodon-tl--show-avatars-p nil)
@@ -290,3 +352,227 @@
(should (equal '(22782 21551) (plist-get properties 'timestamp)))
(should (string-equal "7 minutes ago" (plist-get properties 'display)))))))
+(ert-deftest mastodon-tl--consider-timestamp-for-updates-no-active-callback ()
+ "Should update the timestamp update variables as expected."
+
+ (let* ((now (current-time))
+ (soon-in-the-future (time-add now (seconds-to-time 10000)))
+ (long-in-the-future (time-add now (seconds-to-time 10000000))))
+ (with-temp-buffer
+ ;; start with timer way into the future and no active callback
+ (setq mastodon-tl--timestamp-next-update long-in-the-future
+ mastodon-tl--timestamp-update-timer nil)
+
+ ;; something a later update doesn't update:
+ (with-mock
+ (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+ (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100))))
+
+ (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+ (should (null mastodon-tl--timestamp-update-timer))
+ (should (eq mastodon-tl--timestamp-next-update long-in-the-future)))
+
+ ;; something only shortly sooner doesn't update:
+ (with-mock
+ (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+ (cons "xxx ago" (time-subtract long-in-the-future (seconds-to-time 9))))
+
+ (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+ (should (null mastodon-tl--timestamp-update-timer))
+ (should (eq mastodon-tl--timestamp-next-update long-in-the-future)))
+
+ ;; something much sooner, does update
+ (with-mock
+ (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+ (cons "xxx ago" soon-in-the-future))
+
+ (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+ (should (null mastodon-tl--timestamp-update-timer))
+ (should (eq mastodon-tl--timestamp-next-update soon-in-the-future)))
+ )))
+
+(ert-deftest mastodon-tl--consider-timestamp-for-updates-with-active-callback ()
+ "Should update the timestamp update variables as expected."
+
+ (let* ((now (current-time))
+ (soon-in-the-future (time-add now (seconds-to-time 10000)))
+ (long-in-the-future (time-add now (seconds-to-time 10000000))))
+ (with-temp-buffer
+ ;; start with timer way into the future and no active callback
+ (setq mastodon-tl--timestamp-next-update long-in-the-future
+ mastodon-tl--timestamp-update-timer 'initial-timer)
+
+ ;; something a later update doesn't update:
+ (with-mock
+ (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+ (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100))))
+
+ (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+ (should (eq 'initial-timer mastodon-tl--timestamp-update-timer))
+ (should (eq mastodon-tl--timestamp-next-update long-in-the-future)))
+
+ ;; something much sooner, does update
+ (with-mock
+ (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+ (cons "xxx ago" soon-in-the-future))
+ (mock (cancel-timer 'initial-timer))
+ (mock (run-at-time soon-in-the-future nil
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer) nil) => 'new-timer)
+
+ (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+ (should (eq 'new-timer mastodon-tl--timestamp-update-timer))
+ (should (eq mastodon-tl--timestamp-next-update soon-in-the-future)))
+ )))
+
+(ert-deftest mastodon-tl--find-property-range--no-tag ()
+ "Should cope with a buffer completely lacking the tag."
+ (with-temp-buffer
+ (insert "Just some random text")
+ (insert (propertize "More text with a different property" 'other-property 'set))
+
+ (should (null (mastodon-tl--find-property-range 'test-property 2)))))
+
+(ert-deftest mastodon-tl--find-property-range--earlier-tag ()
+ "Should cope with a buffer completely lacking the tag."
+ (with-temp-buffer
+ (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+ (let ((end-of-region (point)))
+ (insert "More random text")
+
+ (should (null (mastodon-tl--find-property-range 'test-property end-of-region))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding ()
+ "Should find the sought tag in all expected circumstances."
+ (with-temp-buffer
+ (insert "Previous text")
+ (let ((start-of-region (point))
+ end-of-region)
+ (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+ (setq end-of-region (point))
+ (insert "More random text")
+
+ ;; before the region
+ (should (equal (cons start-of-region end-of-region)
+ (mastodon-tl--find-property-range 'test-property 1)))
+ ;; in the region
+ (should (equal (cons start-of-region end-of-region)
+ (mastodon-tl--find-property-range 'test-property (+ 2 start-of-region))))
+ ;; at end of region
+ (should (equal (cons start-of-region end-of-region)
+ (mastodon-tl--find-property-range 'test-property (1- end-of-region)))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding-at-start ()
+ "Should cope with a tag at start."
+ (with-temp-buffer
+ (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+ (let ((end-of-region (point)))
+ (insert "More random text")
+
+ ;; at start of the region
+ (should (equal (cons 1 end-of-region)
+ (mastodon-tl--find-property-range 'test-property 1)))
+ ;; in the region
+ (should (equal (cons 1 end-of-region)
+ (mastodon-tl--find-property-range 'test-property 3)))
+ ;; at end of region
+ (should (equal (cons 1 end-of-region)
+ (mastodon-tl--find-property-range 'test-property (1- end-of-region)))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding-at-end ()
+ "Should cope with a tag at end."
+ (with-temp-buffer
+ (insert "More random text")
+ (let ((start-of-region (point))
+ end-of-region)
+ (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+ (setq end-of-region (point-max))
+
+ ;; before the region
+ (should (equal (cons start-of-region end-of-region)
+ (mastodon-tl--find-property-range 'test-property 1)))
+ ;; in the region
+ (should (equal (cons start-of-region end-of-region)
+ (mastodon-tl--find-property-range 'test-property (1+ start-of-region))))
+ ;; at end of region
+ (should (equal (cons start-of-region end-of-region)
+ (mastodon-tl--find-property-range 'test-property (1- end-of-region)))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding-whole-buffer ()
+ "Should cope with a tag being set for the whole buffer."
+ (with-temp-buffer
+ (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+
+ ;; before the region
+ (should (equal (cons (point-min) (point-max))
+ (mastodon-tl--find-property-range 'test-property 2)))))
+
+(defun tl-tests--all-regions-with-property (property)
+ "Returns a list with (start . end) regions where PROPERTY is set."
+ (let (result
+ region)
+ (goto-char (point-min))
+ (while (and (< (point) (point-max))
+ (setq region (mastodon-tl--find-property-range property (point))))
+ (push region result)
+ (goto-char (min (point-max) (cdr region))))
+ (nreverse result)))
+
+(defun tl-tests--property-values-at (property ranges)
+ "Returns a list with property values at the given ranges.
+
+The property value for PROPERTY within a region is assumed to be
+constant."
+ (let (result)
+ (dolist (range ranges (nreverse result))
+ (push (get-text-property (car range) property) result))))
+
+(ert-deftest mastodon-tl--update-timestamps-callback ()
+ "Should update the 5 timestamps at a time as expected."
+ (let ((now (current-time))
+ markers)
+ (cl-labels ((insert-timestamp (n)
+ (insert (format "\nSome text before timestamp %s:" n))
+ (insert (propertize
+ (format "timestamp #%s" n)
+ 'timestamp (time-subtract now (seconds-to-time (* 60 n)))
+ 'display (format "unset %s" n)))
+ (push (copy-marker (point)) markers)
+ (insert " some more text.")))
+ (with-temp-buffer
+ (cl-dotimes (n 12) (insert-timestamp (+ n 2)))
+ (setq markers (nreverse markers))
+
+ (with-mock
+ (mock (current-time) => now)
+ (stub run-at-time => 'fake-timer)
+
+ ;; make the initial call
+ (mastodon-tl--update-timestamps-callback (current-buffer) nil)
+ (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago"
+ "unset 7" "unset 8" "unset 9" "unset 10" "unset 11" "unset 12" "unset 13")
+ (tl-tests--property-values-at 'display
+ (tl-tests--all-regions-with-property 'timestamp))))
+
+ ;; fake the follow-up call
+ (mastodon-tl--update-timestamps-callback (current-buffer) (nth 4 markers))
+ (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago"
+ "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago"
+ "unset 12" "unset 13")
+ (tl-tests--property-values-at 'display
+ (tl-tests--all-regions-with-property 'timestamp))))
+ (should (null (marker-position (nth 4 markers))))
+
+ ;; fake the follow-up call
+ (mastodon-tl--update-timestamps-callback (current-buffer) (nth 9 markers))
+ (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago"
+ "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago"
+ "12 minutes ago" "13 minutes ago")
+ (tl-tests--property-values-at 'display
+ (tl-tests--all-regions-with-property 'timestamp))))
+ (should (null (marker-position (nth 9 markers)))))))))