Check for presuppositions in `calendar-date-is-valid-p'

Do not signal an error in `calendar-date-is-valid-p' if passed a
value which is not a three-element list of integers.  Signaling
an error makes the function unusable as a predicate for valid
date values. (Bug#74848)
* lisp/calendar/calendar.el (calendar-date-is-valid-p): Add the
check that input is a 3-element list.
* test/lisp/calendar/calendar-tests.el: New file with tests.
This commit is contained in:
Richard Lawrence 2024-12-13 10:41:02 +01:00 committed by Eli Zaretskii
parent fd021c0760
commit 77f73abd92
2 changed files with 50 additions and 13 deletions

View file

@ -2459,19 +2459,22 @@ Returns the corresponding Gregorian date."
(defun calendar-date-is-valid-p (date)
"Return t if DATE is a valid date."
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(and (<= 1 month) (<= month 12)
;; (calendar-read-date t) used to return a date with day = nil.
;; Should not be valid (?), since many funcs prob assume integer.
;; (calendar-read-date 'noday) returns (month year), which
;; currently results in calendar-extract-year returning nil.
day year (<= 1 day) (<= day (calendar-last-day-of-month month year))
;; BC dates left as non-valid, to suppress errors from
;; complex holiday algorithms not suitable for years BC.
;; Note there are side effects on calendar navigation.
(<= 1 year))))
(when (and (listp date)
(length= date 3))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(and (integerp month) (integerp day) (integerp year)
(<= 1 month) (<= month 12)
;; (calendar-read-date t) used to return a date with day = nil.
;; Should not be valid (?), since many funcs prob assume integer.
;; (calendar-read-date 'noday) returns (month year), which
;; currently results in calendar-extract-year returning nil.
day year (<= 1 day) (<= day (calendar-last-day-of-month month year))
;; BC dates left as non-valid, to suppress errors from
;; complex holiday algorithms not suitable for years BC.
;; Note there are side effects on calendar navigation.
(<= 1 year)))))
(defun calendar-date-equal (date1 date2)
"Return t if the DATE1 and DATE2 are the same."

View file

@ -0,0 +1,34 @@
;;; calendar-tests.el --- tests for calendar/calendar.el -*- lexical-binding:t -*-
;; Copyright (C) 2024 Free Software Foundation, Inc.
;; Author: Richard Lawrence <rwl@recursewithless.net>
;; 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 by
;; 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 <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'calendar)
(ert-deftest calendar-test-validity-predicate ()
(should (eq (calendar-date-is-valid-p nil) nil))
(should (eq (calendar-date-is-valid-p "invalid") nil))
(should (eq (calendar-date-is-valid-p (list 1 2)) nil))
(should (eq (calendar-date-is-valid-p (list 5 1 2025)) t)))
(provide 'calendar-tests)
;;; calendar-tests.el ends here