Merge branch 'develop' into fix-numericp

1 files changed, 340 insertions, 0 deletions

diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index d22a169..7d6a08f 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -1,4 +1,5 @@
 (require 'el-mock)
+(require 'cl-macs)
 
 (defconst mastodon-tl-test-base-toot
   '((id . 61208)
@@ -123,6 +124,106 @@ a string or a numeric."
       (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345"))
       (mastodon-tl--updated-json "timelines/foo" "12345"))))
 
+(ert-deftest mastodon-tl--relative-time-description ()
+  "Should format relative time as expected"
+  (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)))
+              (format-seconds-since (seconds)
+                                    (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")
+    (check 59 "less than a minute ago")
+    (check 60 "one minute ago")
+    (check 89 "one minute ago")            ;; rounding down
+    (check 91 "2 minutes ago")             ;; rounding up
+    (check (minutes 3.49) "3 minutes ago") ;; rounding down
+    (check (minutes 3.52) "4 minutes ago")
+    (check (minutes 59) "59 minutes ago")
+    (check (minutes 60) "one hour ago")
+    (check (minutes 89) "one hour ago")
+    (check (minutes 91) "2 hours ago")
+    (check (hours 3.49) "3 hours ago") ;; rounding down
+    (check (hours 3.51) "4 hours ago") ;; rounding down
+    (check (hours 23.4) "23 hours ago")
+    (check (hours 23.6) "one day ago") ;; rounding up
+    (check (days 1.48) "one day ago")  ;; rounding down
+    (check (days 1.52) "2 days ago")   ;; rounding up
+    (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 (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)
@@ -256,3 +357,242 @@ a string or a numeric."
  | (B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time
   ------------")))))
 
+(ert-deftest mastodon-tl--byline-timestamp-has-relative-display ()
+  "Should display the timestamp with a relative time."
+  (let ((mastodon-tl--show-avatars-p nil)
+        (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot))))
+    (with-mock
+      (mock (date-to-time timestamp) => '(22782 21551))
+      (mock (current-time) => '(22782 22000))
+      (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22")
+
+      (let* ((formatted-string (mastodon-tl--byline mastodon-tl-test-base-toot))
+             (timestamp-start (string-match "2999-99-99" formatted-string))
+             (properties (text-properties-at timestamp-start formatted-string)))
+        (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)))))))))