From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Bob Rogers Newsgroups: gmane.emacs.bugs Subject: bug#52209: 28.0.60; [PATCH] date-to-time fails on pure dates Date: Thu, 24 Feb 2022 19:49:14 -0500 Message-ID: <25112.10122.651114.221297@orion.rgrjr.com> References: <7c22f300-eedb-da65-db02-e82025ec2f48@cs.ucla.edu> <87zgoq2vwm.fsf@gnus.org> <25029.60989.564217.290743@orion.rgrjr.com> <87bl1428x5.fsf@gnus.org> <25031.40994.286546.498819@orion.rgrjr.com> <87ee5zzjpg.fsf@gnus.org> <25035.12991.328986.987982@orion.rgrjr.com> <87o84z782g.fsf@gnus.org> <25038.8156.470964.935330@orion.rgrjr.com> <87lezz5x92.fsf@gnus.org> <87h7an7bdm.fsf@igel.home> <25040.62646.635818.692654@orion.rgrjr.com> <87mtkd3vee.fsf@gnus.org> <25043.53490.928476.622599@orion.rgrjr.com> <87lezudw3q.fsf@gnus.org> <25046.8337.837242.510788@orion.rgrjr.com> <25105.33397.961104.269676@orion.rgrjr.com> <87wnhphepw.fsf@igel.home> <87ilt9vicd.fsf@gnus.org> <25106.48460.775490.619228@orion.rgrjr.com> <25110.49174.412406.711346@orion.rgrjr.com> <877d9k4o5s.fsf@gnus.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="ftCty46yS8" Content-Transfer-Encoding: 7bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="8925"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 52209@debbugs.gnu.org, Andreas Schwab , Paul Eggert To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Feb 25 01:50:35 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nNOob-00026P-Ct for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 25 Feb 2022 01:50:33 +0100 Original-Received: from localhost ([::1]:34904 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nNOoZ-0000Iy-QZ for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 24 Feb 2022 19:50:31 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:48646) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nNOo7-0000IW-4E for bug-gnu-emacs@gnu.org; Thu, 24 Feb 2022 19:50:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:56840) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nNOo6-0006Wh-Q9 for bug-gnu-emacs@gnu.org; Thu, 24 Feb 2022 19:50:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nNOo6-0002o8-DH for bug-gnu-emacs@gnu.org; Thu, 24 Feb 2022 19:50:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Bob Rogers Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 25 Feb 2022 00:50:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 52209 X-GNU-PR-Package: emacs Original-Received: via spool by 52209-submit@debbugs.gnu.org id=B52209.164575016110734 (code B ref 52209); Fri, 25 Feb 2022 00:50:02 +0000 Original-Received: (at 52209) by debbugs.gnu.org; 25 Feb 2022 00:49:21 +0000 Original-Received: from localhost ([127.0.0.1]:50737 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nNOnQ-0002n3-72 for submit@debbugs.gnu.org; Thu, 24 Feb 2022 19:49:21 -0500 Original-Received: from rgrjr.com ([69.164.211.47]:51196) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nNOnN-0002mt-Gy for 52209@debbugs.gnu.org; Thu, 24 Feb 2022 19:49:18 -0500 Original-Received: from rgrjr.com (c-73-16-206-7.hsd1.ma.comcast.net [73.16.206.7]) by rgrjr.com (Postfix on openSUSE) with ESMTP id E70B31D6BB2; Fri, 25 Feb 2022 00:49:25 +0000 (UTC) Original-Received: from orion.rgrjr.com (orion.rgrjr.com [192.168.0.3]) by scorpio.rgrjr.com (Postfix on openSUSE GNU/Linux) with ESMTP id 5FEB760116; Thu, 24 Feb 2022 19:49:16 -0500 (EST) In-Reply-To: <877d9k4o5s.fsf@gnus.org> X-Mailer: VM 7.19 under Emacs 29.0.50 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:227600 Archived-At: --ftCty46yS8 Content-Type: text/plain; charset=us-ascii Content-Description: message body text Content-Transfer-Encoding: 7bit From: Lars Ingebrigtsen Date: Thu, 24 Feb 2022 10:19:43 +0100 Bob Rogers writes: > Benchmarking code and results attached. I extracted a handful of > non-error cases from the tests as being more representative than any of > the error cases; the resulting numbers make it seem like any difference > between the two implementations is in the noise. Thanks; that looks quite promising. Can you send a new version of the patch, and I'll get it pushed? Here it is; there should be no changes from what I last sent other than from the suggestions you and Andreas made. Thanks, -- Bob --ftCty46yS8 Content-Type: text/x-patch Content-Disposition: inline; filename="0001-Enhanced-date-parsing-for-ietf-drums.el.patch" Content-Transfer-Encoding: quoted-printable =46rom bdf96f4132cb0433dfcd48b862175ef9bbcc41bb Mon Sep 17 00:00:00 2001 From: Bob Rogers Date: Tue, 1 Feb 2022 14:36:31 -0500 Subject: [PATCH] Enhanced date parsing for ietf-drums.el * lisp/mail/ietf-drums-date.el (added): + (ietf-drums-parse-date-string): parse-time-string replacement which is compatible but can be made stricter if desired. * test/lisp/mail/ietf-drums-date-tests.el (added): + Add tests for ietf-drums-parse-date-string. * lisp/mail/ietf-drums.el: + (ietf-drums-parse-date): Use ietf-drums-parse-date-string. --- lisp/mail/ietf-drums-date.el | 274 ++++++++++++++++++++++++= lisp/mail/ietf-drums.el | 6 +- test/lisp/mail/ietf-drums-date-tests.el | 176 +++++++++++++++ 3 files changed, 455 insertions(+), 1 deletion(-) create mode 100644 lisp/mail/ietf-drums-date.el create mode 100644 test/lisp/mail/ietf-drums-date-tests.el diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.e= l new file mode 100644 index 0000000000..6f64ae7337 --- /dev/null +++ b/lisp/mail/ietf-drums-date.el @@ -0,0 +1,274 @@ +;;; ietf-drums-date.el --- parse time/date for ietf-drums.el -*- lexic= al-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers +;; Keywords: mail, util + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published b= y +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see .= + +;;; Commentary: + +;; 'ietf-drums-parse-date-string' parses a time and/or date in a +;; string and returns a list of values, just like `decode-time', where= +;; unspecified elements in the string are returned as nil (except +;; unspecified DST is returned as -1). `encode-time' may be applied +;; on these values to obtain an internal time value. + +;; Historically, `parse-time-string' was used for this purpose, but it= +;; was gradually but imperfectly extended to handle other date +;; formats. 'ietf-drums-parse-date-string' is compatible in that it +;; uses the same return value format and parses the same email date +;; formats by default, but can be made stricter if desired. + +;;; Code: + +(require 'cl-lib) +(require 'parse-time) + +(define-error 'date-parse-error "Date/time parse error" 'error) + +(defconst ietf-drums-date--slot-names + '(second minute hour day month year weekday dst zone) + "Names of return value slots, for better error messages +See the decoded-time defstruct.") + +(defconst ietf-drums-date--slot-ranges + '((0 60) (0 59) (0 23) (1 31) (1 12) (1 9999)) + "Numeric slot ranges, for bounds checking. +Note that RFC5322 explicitly requires that seconds go up to 60, +to allow for leap seconds (see Mills, D., 'Network Time +Protocol', STD 12, RFC 1119, September 1989).") + +(defsubst ietf-drums-date--ignore-char-p (char) + ;; Ignore whitespace and commas. + (memq char '(=3F\s =3F\t =3F\r =3F\n =3F,))) + +(defun ietf-drums-date--tokenize-string (string &optional comment-eof)= + "Turn STRING into tokens, separated only by whitespace and commas. +Multiple commas are ignored. Pure digit sequences are turned +into integers. If COMMENT-EOF is true, then a comment as +defined by RFC5322 (strictly, the CFWS production that also +accepts comments) is treated as an end-of-file, and no further +tokens are recognized, otherwise we strip out all comments and +treat them as whitespace (per RFC822)." + (let ((index 0) +=09(end (length string)) +=09(list ())) + (cl-flet ((skip-ignored () + ;; Skip ignored characters at index (the scan + ;; position). Skip RFC822 comments in matched parens,= + ;; but do not complain about unterminated comments. + (let ((char nil) + (nest 0)) + (while (and (< index end) + (setq char (aref string index)) + (or (> nest 0) + (ietf-drums-date--ignore-char-p char= ) + (and (not comment-eof) (eql char =3F= \()))) + (cl-incf index) + ;; FWS bookkeeping. + (cond ((and (eq char =3F\\) + (< (1+ index) end)) +=09 ;; Move to the next char but don't check +=09 ;; it to see if it might be a paren. + (cl-incf index)) + ((eq char =3F\() (cl-incf nest)) + ((eq char =3F\)) (cl-decf nest))))))) + (skip-ignored)=09=09;; Skip leading whitespace. + (while (and (< index end) + (not (and comment-eof + (eq (aref string index) =3F\()))) + (let* ((start index) + (char (aref string index)) + (all-digits (<=3D =3F0 char =3F9))) + ;; char is valid; look for more valid characters. + (when (and (eq char =3F\\) + (< (1+ index) end)) + ;; Escaped character, which might be a "(". If so, we are= + ;; correct to include it in the token, even though the + ;; caller is sure to barf. If not, we violate RFC2=3F822 = by + ;; not removing the backslash, but no characters in valid + ;; RFC2=3F822 dates need escaping anyway, so it shouldn't + ;; matter that this is not done strictly correctly. -- + ;; rgr, 24-Dec-21. + (cl-incf index)) + (while (and (< (cl-incf index) end) + (setq char (aref string index)) + (not (or (ietf-drums-date--ignore-char-p char) + (eq char =3F\()))) + (unless (<=3D =3F0 char =3F9) + (setq all-digits nil)) + (when (and (eq char =3F\\) + (< (1+ index) end)) + ;; Escaped character, see above. + (cl-incf index))) + (push (if all-digits + (cl-parse-integer string :start start :end index) + (substring string start index)) + list) + (skip-ignored))) + (nreverse list)))) + +(defun ietf-drums-parse-date-string (time-string &optional error no-82= 2) + "Parse an RFC5322 or RFC822 date, passed as TIME-STRING. +The optional ERROR parameter causes syntax errors to be flagged +by signalling an instance of the date-parse-error condition. The +optional NO-822 parameter disables the more lax RFC822 syntax, +which is permitted by default. + +The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ), +which can be accessed as a decoded-time defstruct (q.v.), +e.g. `decoded-time-year' to extract the year, and turned into an +Emacs timestamp by `encode-time'. + +The strict syntax for RFC5322 is as follows: + + [ day-of-week \",\" ] day FWS month-name FWS year FWS time [CFWS] + +where the \"time\" production is: + + 2DIGIT \":\" 2DIGIT [ \":\" 2DIGIT ] FWS ( \"+\" / \"-\" ) 4DIGIT + +and FWS is \"folding white space,\" and CFWS is \"comments and/or +folding white space\", where comments are included in nesting +parentheses and are equivalent to white space. RFC822 also +accepts comments in random places (all of which is handled by +ietf-drums-date--tokenize-string) and two-digit years. For +two-digit years, 50 and up are interpreted as 1950 through 1999 +and 00 through 49 as 200 through 2049. + +We are somewhat more lax in what we accept (specifically, the +hours don't have to be two digits, and the TZ and the comma after +the DOW are optional), but we do insist that the items that are +present do appear in this order. Unspecified/unrecognized +elements in the string are returned as nil (except unspecified +DST is returned as -1)." + (let ((tokens (ietf-drums-date--tokenize-string (downcase time-strin= g) + no-822)) + (time (list nil nil nil nil nil nil nil -1 nil))) + (cl-labels ((set-matched-slot (slot index token) + ;; Assign a slot value from match data if index is + ;; non-nil, else from token, signalling an error if + ;; enabled and it's out of range. + (let ((value (if index + (cl-parse-integer (match-string ind= ex token)) + token))) + (when error + (let ((range (nth slot ietf-drums-date--slot-ran= ges))) + (when (and range + (not (<=3D (car range) value (cadr = range)))) + (signal 'date-parse-error + (list "Slot out of range" + (nth slot ietf-drums-date--slo= t-names) + token (car range) (cadr range)= ))))) + (setf (nth slot time) value))) + (set-numeric (slot token) + ;; Only assign the slot if the token is a number. + (cond ((natnump token) + (set-matched-slot slot nil token)) + (error + (signal 'date-parse-error + (list "Not a number" + (nth slot ietf-drums-date--slo= t-names) + token)))))) + ;; Check for weekday. + (let ((dow (assoc (car tokens) parse-time-weekdays))) + (when dow + ;; Day of the week. + (set-matched-slot 6 nil (cdr dow)) + (pop tokens))) + ;; Day. + (set-numeric 3 (pop tokens)) + ;; Alphabetic month. + (let* ((month (pop tokens)) + (match (assoc month parse-time-months))) + (cond (match + (set-matched-slot 4 nil (cdr match))) + (error + (signal 'date-parse-error + (list "Expected an alphabetic month" month))) + (t + (push month tokens)))) + ;; Year. + (let ((year (pop tokens))) + ;; Check the year for the right number of digits. + (cond ((not (natnump year)) + (when error + (signal 'date-parse-error + (list "Expected a year" year))) + (push year tokens)) + ((>=3D year 1000) + (set-numeric 5 year)) + ((or no-822 + (>=3D year 100)) + (when error + (signal 'date-parse-error + (list "Four-digit years are required" year))= ) + (push year tokens)) + ((>=3D year 50) + ;; second half of the 20th century. + (set-numeric 5 (+ 1900 year))) + (t + ;; first half of the 21st century. + (set-numeric 5 (+ 2000 year))))) + ;; Time. + (let ((time (pop tokens))) + (cond ((or (null time) (natnump time)) + (when error + (signal 'date-parse-error + (list "Expected a time" time))) + (push time tokens)) + ((string-match + "^\\([0-9][0-9]=3F\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\= )$" + time) + (set-matched-slot 2 1 time) + (set-matched-slot 1 2 time) + (set-matched-slot 0 3 time)) + ((string-match "^\\([0-9][0-9]=3F\\):\\([0-9][0-9]\\)$" = time) + ;; Time without seconds. + (set-matched-slot 2 1 time) + (set-matched-slot 1 2 time) + (set-matched-slot 0 nil 0)) + (error + (signal 'date-parse-error + (list "Expected a time" time))))) + ;; Timezone. + (let* ((zone (pop tokens)) + (match (assoc zone parse-time-zoneinfo))) + (cond (match + (set-matched-slot 8 nil (cadr match)) + (set-matched-slot 7 nil (caddr match))) + ((and (stringp zone) + (string-match "^[-+][0-9][0-9][0-9][0-9]$" zone)) + ;; Numeric time zone. + (set-matched-slot + 8 nil + (* 60 + (+ (cl-parse-integer zone :start 3 :end 5) + (* 60 (cl-parse-integer zone :start 1 :end 3))= ) + (if (=3D (aref zone 0) =3F-) -1 1)))) + ((and zone error) + (signal 'date-parse-error + (list "Expected a timezone" zone))))) + (when (and tokens error) + (signal 'date-parse-error + (list "Extra token(s)" (car tokens))))) + time)) + +(provide 'ietf-drums-date) + +;;; ietf-drums-date.el ends here diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 85aa27235f..d1ad671b16 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -294,9 +294,13 @@ ietf-drums-unfold-fws (replace-match " " t t)) (goto-char (point-min))) =20 +(declare-function ietf-drums-parse-date-string "ietf-drums-date" + (time-string &optional error=3F no-822=3F)) + (defun ietf-drums-parse-date (string) "Return an Emacs time spec from STRING." - (encode-time (parse-time-string string))) + (require 'ietf-drums-date) + (encode-time (ietf-drums-parse-date-string string))) =20 (defun ietf-drums-narrow-to-header () "Narrow to the header section in the current buffer." diff --git a/test/lisp/mail/ietf-drums-date-tests.el b/test/lisp/mail/i= etf-drums-date-tests.el new file mode 100644 index 0000000000..2d4b39dfae --- /dev/null +++ b/test/lisp/mail/ietf-drums-date-tests.el @@ -0,0 +1,176 @@ +;;; ietf-drums-date-tests.el --- Test suite for ietf-drums-date.el -*= - lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published b= y +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see .= + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ietf-drums) +(require 'ietf-drums-date) + +(ert-deftest ietf-drums-date-tests () + "Test basic ietf-drums-parse-date-string functionality." + + ;; Test tokenization. + (should (equal (ietf-drums-date--tokenize-string " ") '())) + (should (equal (ietf-drums-date--tokenize-string " a b") '("a" "b"))= ) + (should (equal (ietf-drums-date--tokenize-string "a bbc dde") + '("a" "bbc" "dde"))) + (should (equal (ietf-drums-date--tokenize-string " , a 27 b,, c 14:3= 2 ") + '("a" 27 "b" "c" "14:32"))) + ;; Some folding whitespace tests. + (should (equal (ietf-drums-date--tokenize-string " a b (end) c" t) + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "(quux)a (foo (bar)= ) b(baz)") + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\cde") + ;; Strictly incorrect, but strictly unnecessary synta= x. + '("a" "b\\cde"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\ de") + '("a" "b\\ de"))) + (should (equal (ietf-drums-date--tokenize-string "a \\de \\(f") + '("a" "\\de" "\\(f"))) + + ;; Start with some compatible RFC822 dates. + (dolist (case '(("Mon, 22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 nil -1 3600) + (22219 21758)) + ("Mon, 22 February 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Mon, 22 feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Monday, 22 february 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Monday, 22 february 2016 19:35:42 PST" + (42 35 19 22 2 2016 1 nil -28800) + (22219 54158)) + ("Friday, 21 Sep 2018 13:47:58 PDT" + (58 47 13 21 9 2018 5 t -25200) + (23461 22782)) + ("Friday, 21 Sep 2018 13:47:58" + (58 47 13 21 9 2018 5 -1 nil) + (23461 11982)))) + (let* ((input (car case)) + (parsed (cadr case)) + (encoded (caddr case))) + ;; The input should parse the same without RFC822. + (should (equal (ietf-drums-parse-date-string input) pars= ed)) + (should (equal (ietf-drums-parse-date-string input nil t= ) parsed)) + ;; Check the encoded date (the official output, though + ;; the decoded-time is easier to debug). + (should (equal (ietf-drums-parse-date input) encoded))))= + + ;; Two-digit years are not allowed by the "modern" format. + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +01= 00") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +01= 00" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 16 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 16= ))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +01= 00") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +01= 00" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 96 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 96= ))) + + ;; Try some dates with comments. + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" t t= )) + '(date-parse-error "Expected a year" nil))) + (should (equal (ietf-drums-parse-date-string + "22 Feb 96 (long ago) 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep(comment \\) with \\( parens)18 19:35= :42") + '(42 35 19 21 9 2018 5 -1 nil))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep 18 19:35:42 (unterminated comment") + '(42 35 19 21 9 2018 5 -1 nil))) + + ;; Test some RFC822 error cases + (dolist (test '(("33 1 2022" ("Slot out of range" day 33 1 31)) + ("0 1 2022" ("Slot out of range" day 0 1 31)) + ("1 1 2020 2021" ("Expected an alphabetic month" 1))= + ("1 Jan 2020 2021" ("Expected a time" 2021)) + ("1 Jan 2020 20:21 2000" ("Expected a timezone" 2000= )) + ("1 Jan 2020 20:21 +0200 33" ("Extra token(s)" 33)))= ) + (should (equal (should-error (ietf-drums-parse-date-string (car te= st) t)) + (cons 'date-parse-error (cadr test))))) + + (dolist (test '(("22 Feb 196" nil=09=09;; bad year + ("Four-digit years are required" 196)) + ("22 Feb 16 19:35:24" t=09;; two-digit year + ("Four-digit years are required" 16)) + ("22 Feb 96 19:35:42" t=09;; two-digit year + ("Four-digit years are required" 96)) + ("2 Feb 2021 1996" nil + ("Expected a time" 1996)) + ("22 Fub 1996" nil + ("Expected an alphabetic month" "fub")) + ("1 Jan 2020 30" nil + ("Expected a time" 30)) + ("1 Jan 2020 16:47 15:15" nil + ("Expected a timezone" "15:15")) + ("1 Jan 2020 16:47 +0800 -0800" t + ("Extra token(s)" "-0800")) + ;; Range tests + ("32 Dec 2021" nil + ("Slot out of range" day 32 1 31)) + ("0 Dec 2021" nil + ("Slot out of range" day 0 1 31)) + ("3 13 2021" nil + ("Expected an alphabetic month" 13)) + ("3 Dec 0000" t + ("Four-digit years are required" 0)) + ("3 Dec 20021" nil + ("Slot out of range" year 20021 1 9999)) + ("1 Jan 2020 24:21:14" nil + ("Slot out of range" hour "24:21:14" 0 23)) + ("1 Jan 2020 14:60:21" nil + ("Slot out of range" minute "14:60:21" 0 59)) + ("1 Jan 2020 14:21:61" nil + ("Slot out of range" second "14:21:61" 0 60)))) + (should (equal (should-error + (ietf-drums-parse-date-string (car test) t (cadr t= est))) + (cons 'date-parse-error (caddr test))))) + (should (equal (ietf-drums-parse-date-string + "1 Jan 2020 14:21:60")=09;; a leap second! + '(60 21 14 1 1 2020 nil -1 nil)))) + +(provide 'ietf-drums-date-tests) + +;;; ietf-drums-date-tests.el ends here --=20 2.34.1 --ftCty46yS8--