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.

diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 75bbae58b27f81d5d6a6564041d78adcdd77decd..c13ba8b940b9ca0e1d2dffce39055115d6235cd4 100644 (file)
--- 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 bdfc0e44dddcffc00a3d45aa3fbe32f8ac8960b2..c410ffe449c1d192de81db88a5b0752722766440 100644 (file)
--- 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 77d939eb4062a0eabd30555f5599e2f9feeba9b7..e1ee20b5d2dd07660cb4e55e80dd1d53e83a28e2 100644 (file)
--- 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