add unittest for bugzilla 790526

This commit is contained in:
christopherlam 2017-12-20 07:58:03 +08:00 committed by GitHub
parent f3bc8eea8b
commit b6ec61fa45
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -0,0 +1,42 @@
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(use-modules (gnucash engine test test-extras))
(define (run-test)
(and (test test-weeknum-calculator)))
(define (create->time64 l)
(let ((now (gnc-localtime (current-time))))
(set-tm:sec now (list-ref l 0))
(set-tm:min now (list-ref l 1))
(set-tm:hour now (list-ref l 2))
(set-tm:mday now (list-ref l 3))
(set-tm:mon now (list-ref l 4))
(set-tm:year now (list-ref l 5))
(set-tm:isdst now -1)
(gnc-mktime now)))
(define (list->time64 l)
(create-time64 (list-ref l 0) (list-ref l 1) (list-ref l 2)
(list-ref l 3) (list-ref l 4) (list-ref l 5)))
(define (weeknums-equal? pair-of-dates)
(let ((d1 (car pair-of-dates))
(d2 (cdr pair-of-dates)))
(equal? (gnc:date-to-week (list->time64 d1))
(gnc:date-to-week (list->time64 d2)))))
(define (test-weeknum-calculator)
(and (weeknums-equal? (cons '(1970 1 1 0 0 0)
'(1970 1 1 23 59 59)))
(weeknums-equal? (cons '(1969 12 31 0 0 0)
'(1969 12 31 23 59 59)))
(weeknums-equal? (cons '(1969 12 31 0 0 0)
'(1970 1 1 0 0 1)))
(weeknums-equal? (cons '(2001 1 1 0 0 0)
'(2001 1 1 23 59 59)))
(not (weeknums-equal? (cons '(1970 1 1 0 0 0)
'(1970 1 10 0 0 1))))
(not (weeknums-equal? (cons '(1969 12 28 0 0 1)
'(1970 1 5 0 0 1))))
))