bug#52209: 28.0.60; [PATCH] date-to-time fails on pure dates

[Bob Rogers]

   From: Paul Eggert <eggert@cs.ucla.edu>
   Date: Sat, 4 Dec 2021 10:58:37 -0800

   Unfortunately the latest change to time-date.el reintroduced
   Bug#52209.  I installed the attached patch to fix this . . .

I'm sure none of you will be surprised to learn that parse-time-string
still doesn't recognize single-digit months or days, with the same
fallback-to-the-epoch behavior that threw me for a loop originally.

    (format-time-string "%F %T %z" (date-to-time "2022-1-12"))
        => "1999-12-31 19:00:00 -0500"

And adding a time makes it work again because it seems that
timezone-make-date-arpa-standard does accept single-digit months and
days.  Go figure.

   The attached patch extends parse-time-string by using regexps instead
of string manipulation of fixed-width fields.  This could possibly break
interface compatibility, especially if you expect anyone to customize
parse-time-rules.  So I will not be surprised if you decline to adopt
it.

   > (These functions were never really intended to support parsing dates
   > like that -- only strict RFC822 date strings were originally supported,
   > but it's become more DWIM as time has passed.

   Yes, date-to-time has definitely ... evolved.

   My understanding is that date-to-time's RFC822 parsing is present
   only for backward compatibility, and that we shouldn't attempt to
   enhance it (here, the enhancement would be pointless as the RFC822
   parsing fills in the blanks anyway). So the patch I just installed
   adds the new feature only for the normal path taken, when not doing
   the RFC822 hack.

   PS. Internet RFC 822 has been obsolete since 2001, and the Emacs code
   should be talking about RFC 5322 everywhere except when Emacs is
   explicitly supporting the obsolete standard instead of the current
   standard. And we should rename functions like rfc822-goto-eoh to
   rfc-email-goto-eoh, to help avoid confusion or further function
   renaming. But I digress....

Since Emacs time functions have evolved well beyond email, I would argue
that even "rfc-email-" is too specific a prefix for them.  So if this
patch is not suitable, maybe it's (cough, cough) time for a new time and
date parsing API that supports a broader range of human-generated dates
and times, with better error handling and I18N support.  WDYT?

                                        -- Bob Rogers
                                           http://www.rgrjr.com/

diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 5a3d2706af..4812dcbd1b 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -102,45 +102,25 @@ parse-time-rules
     ((3) (1 31))
     ((4) parse-time-months)
     ((5) (100))
-    ((2 1 0)
-     ,(lambda () (and (stringp parse-time-elt)
-                      (= (length parse-time-elt) 8)
-                      (= (aref parse-time-elt 2) ?:)
-                      (= (aref parse-time-elt 5) ?:)))
-     [0 2] [3 5] [6 8])
     ((8 7) parse-time-zoneinfo
      ,(lambda () (car parse-time-val))
      ,(lambda () (cadr parse-time-val)))
     ((8)
+     "^[-+][0-9][0-9][0-9][0-9]$"
      ,(lambda ()
-        (and (stringp parse-time-elt)
-             (= 5 (length parse-time-elt))
-             (or (= (aref parse-time-elt 0) ?+)
-                 (= (aref parse-time-elt 0) ?-))))
-     ,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
-                          (* 60 (cl-parse-integer parse-time-elt :start 1 :end 
3)))
-                    (if (= (aref parse-time-elt 0) ?-) -1 1))))
+        (* 60
+           (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
+              (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
+           (if (= (aref parse-time-elt 0) ?-) -1 1))))
     ((5 4 3)
-     ,(lambda () (and (stringp parse-time-elt)
-                      (= (length parse-time-elt) 10)
-                      (= (aref parse-time-elt 4) ?-)
-                      (= (aref parse-time-elt 7) ?-)))
-     [0 4] [5 7] [8 10])
-    ((2 1 0)
-     ,(lambda () (and (stringp parse-time-elt)
-                      (= (length parse-time-elt) 5)
-                      (= (aref parse-time-elt 2) ?:)))
-     [0 2] [3 5] ,(lambda () 0))
+     "^\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]?\\)-\\([0-9][0-9]?\\)$"
+     1 2 3)
     ((2 1 0)
-     ,(lambda () (and (stringp parse-time-elt)
-                      (= (length parse-time-elt) 4)
-                      (= (aref parse-time-elt 1) ?:)))
-     [0 1] [2 4] ,(lambda () 0))
+     "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\)$"
+     1 2 ,(lambda () 0))
     ((2 1 0)
-     ,(lambda () (and (stringp parse-time-elt)
-                      (= (length parse-time-elt) 7)
-                      (= (aref parse-time-elt 1) ?:)))
-     [0 1] [2 4] [5 7])
+     "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$"
+     1 2 3)
     ((5) (50 110) ,(lambda () (+ 1900 parse-time-elt)))
     ((5) (0 49) ,(lambda () (+ 2000 parse-time-elt))))
   "(slots predicate extractor...)")
@@ -173,7 +153,11 @@ parse-time-string
                    (parse-time-val))
               (when (and (not (nth (car slots) time)) ;not already set
                          (setq parse-time-val
-                               (cond ((and (consp predicate)
+                               (cond ((stringp predicate)
+                                        (and (stringp parse-time-elt)
+                                             (string-match predicate
+                                                           parse-time-elt)))
+                                      ((and (consp predicate)
                                            (not (functionp predicate)))
                                       (and (numberp parse-time-elt)
                                            (<= (car predicate) parse-time-elt)
@@ -188,15 +172,15 @@ parse-time-string
                 (setq exit t)
                 (while slots
                   (let ((new-val (if rule
-                                     (let ((this (pop rule)))
-                                       (if (vectorp this)
-                                           (cl-parse-integer
-                                            parse-time-elt
-                                            :start (aref this 0)
-                                            :end (aref this 1))
-                                         (funcall this)))
+                                     (let* ((this (pop rule)))
+                                        (if (integerp this)
+                                            (cl-parse-integer
+                                              (match-string this 
parse-time-elt))
+                                          (funcall this)))
                                    parse-time-val)))
-                    (setf (nth (pop slots) time) new-val))))))))
+                     (setf (nth (pop slots) time) new-val))))))
+           (unless exit
+             (message "unrecognized token '%s'" parse-time-elt))))
        time))))
 
 (defun parse-iso8601-time-string (date-string)
diff --git a/test/lisp/calendar/parse-time-tests.el 
b/test/lisp/calendar/parse-time-tests.el
index b706b73570..63b696db1d 100644
--- a/test/lisp/calendar/parse-time-tests.el
+++ b/test/lisp/calendar/parse-time-tests.el
@@ -45,6 +45,36 @@ parse-time-tests
                  '(42 35 19 22 2 2016 1 nil -28800)))
   (should (equal (parse-time-string "Friday, 21 Sep 2018 13:47:58 PDT")
                  '(58 47 13 21 9 2018 5 t -25200)))
+  (should (equal (parse-time-string "Friday, 21 Sep 2018 13:47:58")
+                 '(58 47 13 21 9 2018 5 -1 nil)))
+  (should (equal (parse-time-string "Friday, 21 Sep 2018")
+                 '(nil nil nil 21 9 2018 5 -1 nil)))
+  ;; Date can be numeric if separated by hyphens.
+  (should (equal (parse-time-string "Friday, 2018-09-21")
+                 '(nil nil nil 21 9 2018 5 -1 nil)))
+  ;; Day of week is optional
+  (should (equal (parse-time-string "2018-09-21")
+                 '(nil nil nil 21 9 2018 nil -1 nil)))
+  ;; The order of date, time, etc., does not matter.
+  (should (equal (parse-time-string "13:47:58, +0100, 2018-09-21, Friday")
+                 '(58 47 13 21 9 2018 5 -1 3600)))
+  ;; Month, day, or both, can be a single digit.
+  (should (equal (parse-time-string "Friday, 2018-9-08")
+                 '(nil nil nil 8 9 2018 5 -1 nil)))
+  (should (equal (parse-time-string "Friday, 2018-09-8")
+                 '(nil nil nil 8 9 2018 5 -1 nil)))
+  (should (equal (parse-time-string "Friday, 2018-9-8")
+                 '(nil nil nil 8 9 2018 5 -1 nil)))
+  ;; Time by itself is recognized as such.
+  (should (equal (parse-time-string "03:47:58")
+                 '(58 47 3 nil nil nil nil -1 nil)))
+  ;; A leading zero for hours is optional.
+  (should (equal (parse-time-string "3:47:58")
+                 '(58 47 3 nil nil nil nil -1 nil)))
+  ;; Missing seconds are assumed to be zero.
+  (should (equal (parse-time-string "3:47")
+                 '(0 47 3 nil nil nil nil -1 nil)))
+
   (should (equal (format-time-string
                  "%Y-%m-%d %H:%M:%S"
                  (parse-iso8601-time-string "1998-09-12T12:21:54-0200") t)