Commit 4cb16b6f authored by Mattias Engdegård's avatar Mattias Engdegård

Calc: fix business days calculation (bug43677)

The calculation of business days was broken in 2012 (probably
310e60d9 or thereabouts) when the date representation changed
epoch so that Jan 1, 1 AD became day number 1 instead of 0.  Repair
this, along with an unrelated bug that prevented arbitrary holiday
weekdays from working.

Reported by Aaron Zeng.

* lisp/calc/calc-forms.el (math-to-business-day)
(math-from-business-day): Correct calculation of weekdays using Calc's
current (Rata Die) chronology.  Modify loop condition to cope with odd
sets of holiday weekdays.
* test/lisp/calc/calc-tests.el (calc-business-days): New test.
parent d037a6a2
Pipeline #7206 failed with stage
in 40 minutes and 33 seconds
......@@ -1870,8 +1870,8 @@ and ends on the last Sunday of October at 2 a.m."
(and days (= day (car days))
(setq holiday t)))
(let* ((weekdays (nth 3 math-holidays-cache))
(weeks (1- (/ (+ day 6) 7)))
(wkday (- day 1 (* weeks 7))))
(weeks (/ day 7))
(wkday (mod day 7))) ; Day of week: 0=Sunday, 6=Saturday
(setq delta (+ delta (* weeks (length weekdays))))
(while (and weekdays (< (car weekdays) wkday))
(setq weekdays (cdr weekdays)
......@@ -1905,14 +1905,15 @@ and ends on the last Sunday of October at 2 a.m."
(setq delta (1+ delta)))
(setq day (+ day delta)))
(let* ((weekdays (nth 3 math-holidays-cache))
(bweek (- 7 (length weekdays)))
(weeks (1- (/ (+ day (1- bweek)) bweek)))
(wkday (- day 1 (* weeks bweek)))
(bweek (- 7 (length weekdays))) ; Business days in a week, 1..7.
(weeks (/ day bweek)) ; Whole weeks.
(wkday (mod day bweek)) ; Business day in last week, 0..bweek-1
(w 0))
(setq day (+ day (* weeks (length weekdays))))
;; Add business days in the last week; `w' is weekday, 0..6.
(while (if (memq w weekdays)
(setq day (1+ day))
(> (setq wkday (1- wkday)) 0))
(>= (setq wkday (1- wkday)) 0))
(setq w (1+ w)))
(let ((hours (nth 7 math-holidays-cache)))
(if hours
......
......@@ -458,6 +458,82 @@ An existing calc stack is reused, otherwise a new one is created."
(calcFunc-choose '(frac -15 2) 3))
(calc-tests--choose -7.5 3))))
(ert-deftest calc-business-days ()
(cl-flet ((m (s) (math-parse-date s))
(b+ (a b) (calcFunc-badd a b))
(b- (a b) (calcFunc-bsub a b)))
;; Sanity check.
(should (equal (m "2020-09-07") '(date 737675)))
;; Test with standard business days (Mon-Fri):
(should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-08") 1) (m "2020-09-09"))) ; Tue->Wed
(should (equal (b+ (m "2020-09-09") 1) (m "2020-09-10"))) ; Wed->Thu
(should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
(should (equal (b+ (m "2020-09-11") 1) (m "2020-09-14"))) ; Fri->Mon
(should (equal (b+ (m "2020-09-07") 4) (m "2020-09-11"))) ; Mon->Fri
(should (equal (b+ (m "2020-09-07") 6) (m "2020-09-15"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-12") 1) (m "2020-09-14"))) ; Sat->Mon
(should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
(should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
(should (equal (b- (m "2020-09-10") 1) (m "2020-09-09"))) ; Thu->Wed
(should (equal (b- (m "2020-09-09") 1) (m "2020-09-08"))) ; Wed->Tue
(should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
(should (equal (b- (m "2020-09-07") 1) (m "2020-09-04"))) ; Mon->Fri
(should (equal (b- (m "2020-09-11") 4) (m "2020-09-07"))) ; Fri->Mon
(should (equal (b- (m "2020-09-15") 6) (m "2020-09-07"))) ; Tue->Mon
(should (equal (b- (m "2020-09-12") 1) (m "2020-09-11"))) ; Sat->Fri
(should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
;; Stepping fractional days
(should (equal (b+ (m "2020-09-08 21:00") '(frac 1 2))
(m "2020-09-09 09:00")))
(should (equal (b+ (m "2020-09-11 21:00") '(frac 1 2))
(m "2020-09-14 09:00")))
(should (equal (b- (m "2020-09-08 21:00") '(frac 1 2))
(m "2020-09-08 09:00")))
(should (equal (b- (m "2020-09-14 06:00") '(frac 1 2))
(m "2020-09-11 18:00")))
;; Test with a couple of extra days off:
(let ((var-Holidays (list 'vec
'(var sat var-sat) '(var sun var-sun)
(m "2020-09-09") (m "2020-09-11"))))
(should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-08") 1) (m "2020-09-10"))) ; Tue->Thu
(should (equal (b+ (m "2020-09-10") 1) (m "2020-09-14"))) ; Thu->Mon
(should (equal (b+ (m "2020-09-14") 1) (m "2020-09-15"))) ; Mon->Tue
(should (equal (b+ (m "2020-09-15") 1) (m "2020-09-16"))) ; Tue->Wed
(should (equal (b- (m "2020-09-16") 1) (m "2020-09-15"))) ; Wed->Tue
(should (equal (b- (m "2020-09-15") 1) (m "2020-09-14"))) ; Tue->Mon
(should (equal (b- (m "2020-09-14") 1) (m "2020-09-10"))) ; Mon->Thu
(should (equal (b- (m "2020-09-10") 1) (m "2020-09-08"))) ; Thu->Tue
(should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
)
;; Test with odd non-business weekdays (Tue, Wed, Sat):
(let ((var-Holidays '(vec (var tue var-tue)
(var wed var-wed)
(var sat var-sat))))
(should (equal (b+ (m "2020-09-07") 1) (m "2020-09-10"))) ; Mon->Thu
(should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
(should (equal (b+ (m "2020-09-11") 1) (m "2020-09-13"))) ; Fri->Sun
(should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
(should (equal (b- (m "2020-09-14") 1) (m "2020-09-13"))) ; Mon->Sun
(should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
(should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
(should (equal (b- (m "2020-09-10") 1) (m "2020-09-07"))) ; Thu->Mon
)
))
(provide 'calc-tests)
;;; calc-tests.el ends here
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment