[Emacs-diffs] master 4ce9c6d: Fix various Calc date conversions (bug#36822)

[Mattias Engdegård]

branch: master
commit 4ce9c6d0b58bd77bc811d6c1c5caf955a5a0be2f
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Fix various Calc date conversions (bug#36822)
    
    * lisp/calc/calc-forms.el (math-absolute-from-gregorian-dt):
    Rewrite in a way that I understand, and that actually seems to work.
    (math-absolute-from-julian-dt): Use Julian, not Gregorian, leap year
    rules for counting days within a year.
    (math-julian-date-beginning, math-julian-date-beginning-int):
    Change constants to be consistent with their doc strings and the code:
    use Rata Die epoch at Dec 31, 1 BC Gregorian proleptic, not Julian.
    * doc/misc/calc.texi (Date Forms): Correct difference between Julian
    Day and Rata Die.
    * test/lisp/calc/calc-tests.el (calc-test-calendar): New test.
---
 doc/misc/calc.texi           |  4 ++--
 lisp/calc/calc-forms.el      | 38 ++++++++++++--------------------------
 test/lisp/calc/calc-tests.el | 21 +++++++++++++++++++++
 3 files changed, 35 insertions(+), 28 deletions(-)

diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 75bbae5..c13ba8b 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -11055,9 +11055,9 @@ Another day counting system in common use is, 
confusingly, also called
 is the numbers of days since 12:00 noon (GMT) on November 24, 4714 BC
 in the Gregorian calendar (i.e., January 1, 4713 BC in the Julian
 calendar).  In Calc's scheme (in GMT) the Julian day origin is
-@mathit{-1721422.5}, because Calc starts at midnight instead of noon.
+@mathit{-1721424.5}, because Calc starts at midnight instead of noon.
 Thus to convert a Calc date code obtained by unpacking a
-date form into a Julian day number, simply add 1721422.5 after
+date form into a Julian day number, simply add 1721424.5 after
 compensating for the time zone difference.  The built-in @kbd{t J}
 command performs this conversion for you.
 
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index bdfc0e4..c410ffe 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -587,29 +587,15 @@ A DT is a list of the form (YEAR MONTH DAY)."
   "Return the DATE of the day given by the Gregorian day YEAR MONTH DAY.
 Recall that DATE is the number of days since December 31, -1
 in the Gregorian calendar."
-  (if (eq year 0) (setq year -1))
-  (let ((yearm1 (math-sub year 1)))
-    (math-sub
-     ;; Add the number of days of the year and the numbers of days
-     ;; in the previous years (leap year days to be added separately)
-     (math-add (math-day-in-year year month day)
-               (math-add (math-mul 365 yearm1)
-                         ;; Add the number of Julian leap years
-                         (if (math-posp year)
-                             (math-quotient yearm1 4)
-                           (math-sub 365
-                                     (math-quotient (math-sub 3 year)
-                                                    4)))))
-     ;; Subtract the number of Julian leap years which are not
-     ;; Gregorian leap years.  In C=4N+r centuries, there will
-     ;; be 3N+r of these days.  The following will compute
-     ;; 3N+r.
-     (let* ((correction (math-mul (math-quotient yearm1 100) 3))
-            (res (math-idivmod correction 4)))
-       (math-add (if (= (cdr res) 0)
-                     0
-                   1)
-                 (car res))))))
+  (when (zerop year)                    ; Year -1 precedes year 1.
+    (setq year -1))
+  (let* ((y (if (> year 0) year (+ year 1)))  ; Astronomical year (with 0).
+         (y1 (- y 1)))                        ; Previous year.
+    (+ (* y1 365)                    ; Days up to the previous year...
+       (floor y1 4)                  ; ... including leap days.
+       (- (floor y1 100))
+       (floor y1 400)
+       (math-day-in-year year month day))))
 
 (defun math-absolute-from-julian-dt (year month day)
   "Return the DATE of the day given by the Julian day YEAR MONTH DAY.
@@ -620,7 +606,7 @@ in the Gregorian calendar."
     (math-sub
      ;; Add the number of days of the year and the numbers of days
      ;; in the previous years (leap year days to be added separately)
-     (math-add (math-day-in-year year month day)
+     (math-add (math-day-in-year year month day t)
                (math-add (math-mul 365 yearm1)
                          ;; Add the number of Julian leap years
                          (if (math-posp year)
@@ -714,11 +700,11 @@ in the Gregorian calendar."
               (setcdr math-fd-dt nil))
          fmt))))
 
-(defconst math-julian-date-beginning '(float 17214225 -1)
+(defconst math-julian-date-beginning '(float 17214245 -1)
   "The beginning of the Julian date calendar,
 as measured in the number of days before December 31, 1 BC (Gregorian).")
 
-(defconst math-julian-date-beginning-int 1721423
+(defconst math-julian-date-beginning-int 1721425
   "The beginning of the Julian date calendar,
 as measured in the integer number of days before December 31, 1 BC 
(Gregorian).")
 
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 77d939e..e1ee20b 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -193,6 +193,27 @@ An existing calc stack is reused, otherwise a new one is 
created."
     (let ((calc-number-radix 36))
       (should (equal (math-format-number 12345678901) "36#5,O6A,QT1")))))
 
+(ert-deftest calc-test-calendar ()
+  "Test calendar conversions (bug#36822)."
+  (should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692))
+  (should (equal (math-parse-date "2019-07-27") '(date 737267)))
+  (should (equal (calcFunc-julian '(date 0)) 1721425))
+  (should (equal (math-date-to-gregorian-dt 1) '(1 1 1)))
+  (should (equal (math-date-to-gregorian-dt 0) '(-1 12 31)))
+  (should (equal (math-date-to-gregorian-dt -1721425) '(-4714 11 24)))
+  (should (equal (math-absolute-from-gregorian-dt 2019 7 27) 737267))
+  (should (equal (math-absolute-from-gregorian-dt 1 1 1) 1))
+  (should (equal (math-absolute-from-gregorian-dt -1 12 31) 0))
+  (should (equal (math-absolute-from-gregorian-dt -99 12 31) -35795))
+  (should (equal (math-absolute-from-gregorian-dt -4714 11 24) -1721425))
+  (should (equal (calcFunc-julian '(date -1721425)) 0))
+  (should (equal (math-date-to-julian-dt 1) '(1 1 3)))
+  (should (equal (math-date-to-julian-dt -1721425) '(-4713 1 1)))
+  (should (equal (math-absolute-from-julian-dt 2019 1 1) 737073))
+  (should (equal (math-absolute-from-julian-dt 1 1 3) 1))
+  (should (equal (math-absolute-from-julian-dt -101 1 1) -36892))
+  (should (equal (math-absolute-from-julian-dt -101 3 1) -36832))
+  (should (equal (math-absolute-from-julian-dt -4713 1 1) -1721425)))
 
 (provide 'calc-tests)
 ;;; calc-tests.el ends here