mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge branch 'maint' into unstable
This commit is contained in:
commit
3d2682ac04
@ -40,6 +40,7 @@ SET(GUILE_DEPENDS
|
||||
set(test_app_utils_scheme_SOURCES
|
||||
test-c-interface.scm
|
||||
test-load-app-utils-module.scm
|
||||
test-date-utilities.scm
|
||||
)
|
||||
|
||||
GNC_ADD_SCHEME_TARGETS(scm-test-load-app-utils-module
|
||||
|
@ -77,7 +77,7 @@ test_app_utils_CXXFLAGS = \
|
||||
-DTESTPROG=test_app_utils \
|
||||
${GLIB_CFLAGS}
|
||||
|
||||
SCM_TESTS = test-load-app-utils-module test-c-interface
|
||||
SCM_TESTS = test-load-app-utils-module test-c-interface test-date-utilities
|
||||
SCM_TEST_SRCS = $(SCM_TESTS:%=%.scm)
|
||||
|
||||
$(SCM_TESTS): %: $(srcdir)/%.scm Makefile
|
||||
|
38
libgnucash/app-utils/test/test-date-utilities.scm
Normal file
38
libgnucash/app-utils/test/test-date-utilities.scm
Normal file
@ -0,0 +1,38 @@
|
||||
(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 5))
|
||||
(set-tm:min now (list-ref l 4))
|
||||
(set-tm:hour now (list-ref l 3))
|
||||
(set-tm:mday now (list-ref l 2))
|
||||
(set-tm:mon now (list-ref l 1))
|
||||
(set-tm:year now (list-ref l 0))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (weeknums-equal? pair-of-dates)
|
||||
(let ((d1 (car pair-of-dates))
|
||||
(d2 (cdr pair-of-dates)))
|
||||
(equal? (gnc:date-to-week (create-time64 d1))
|
||||
(gnc:date-to-week (create-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))))
|
||||
))
|
Loading…
Reference in New Issue
Block a user