diff options
author | Holger Dürer <me@hdurer.net> | 2017-05-20 20:00:24 +0100 |
---|---|---|
committer | Holger Dürer <me@hdurer.net> | 2017-06-19 17:16:29 +0100 |
commit | 746694f0ea75f5fa76739d49509836ccd67d7d65 (patch) | |
tree | d52459be2372625060b6de7339aac0a526c00d3a /test/mastodon-tl-tests.el | |
parent | 20e3b77a9a37373754d0adedcee2ede6cf1f5922 (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.el | 294 |
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))))))))) |