mirror of
https://github.com/Gnucash/gnucash.git
synced 2024-11-29 20:24:25 -06:00
test-date-utilities.scm: to SRFI64
Clearer syntax helped find flawed test - while set-tm:mday directly accepts 1-31, set-tm:mon accepts 0-11 to represent 1-12, therefore must minus 1. set-tm:year accepts 92 to represent 1992, therefore must minus 1900.
This commit is contained in:
parent
13f31e0691
commit
97ab1b19fe
@ -43,6 +43,9 @@ set(GUILE_DEPENDS
|
||||
set(test_app_utils_scheme_SOURCES
|
||||
test-c-interface.scm
|
||||
test-load-app-utils-module.scm
|
||||
)
|
||||
|
||||
set (test_app_utils_scheme_SRFI64_SOURCES
|
||||
test-date-utilities.scm
|
||||
)
|
||||
|
||||
@ -61,6 +64,11 @@ gnc_add_scheme_targets(scm-test-c-interface
|
||||
)
|
||||
|
||||
gnc_add_scheme_tests("${test_app_utils_scheme_SOURCES}")
|
||||
|
||||
if (HAVE_SRFI64)
|
||||
gnc_add_scheme_tests("${test_app_utils_scheme_SRFI64_SOURCES}")
|
||||
endif ()
|
||||
|
||||
# Doesn't work yet:
|
||||
gnc_add_test_with_guile(test-app-utils "${test_app_utils_SOURCES}" APP_UTILS_TEST_INCLUDE_DIRS APP_UTILS_TEST_LIBS)
|
||||
|
||||
|
@ -1,10 +1,15 @@
|
||||
(use-modules (gnucash gnc-module))
|
||||
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
|
||||
(use-modules (gnucash engine test test-extras))
|
||||
(use-modules (srfi srfi-64))
|
||||
(use-modules (gnucash engine test srfi64-extras))
|
||||
|
||||
(define (run-test)
|
||||
(and (test test-weeknum-calculator)
|
||||
(test test-date-get-quarter-string)))
|
||||
(test-runner-factory gnc:test-runner)
|
||||
(test-begin "test-date-utilities.scm")
|
||||
(test-weeknum-calculator)
|
||||
(test-date-get-quarter-string)
|
||||
(test-end "test-date-utilities.scm"))
|
||||
|
||||
(define (create-datevec l)
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
@ -12,8 +17,8 @@
|
||||
(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:mon now (1- (list-ref l 1)))
|
||||
(set-tm:year now (- (list-ref l 0) 1900))
|
||||
(set-tm:isdst now -1)
|
||||
now))
|
||||
|
||||
@ -28,28 +33,39 @@
|
||||
(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))))
|
||||
))
|
||||
(test-assert "weeknums 1/1/70early = 1/1/70late"
|
||||
(weeknums-equal? (cons '(1970 1 1 0 0 0)
|
||||
'(1970 1 1 23 59 59))))
|
||||
|
||||
(test-assert "weeknums 31/12/69early = 31/12/69late"
|
||||
(weeknums-equal? (cons '(1969 12 31 0 0 0)
|
||||
'(1969 12 31 23 59 59))))
|
||||
|
||||
(test-assert "weeknums 31/12/69 = 1/1/70"
|
||||
(weeknums-equal? (cons '(1969 12 31 0 0 0)
|
||||
'(1970 1 1 0 0 1))))
|
||||
|
||||
(test-assert "weeknums 1/1/01early = 01/01/01 late"
|
||||
(weeknums-equal? (cons '(2001 1 1 0 0 0)
|
||||
'(2001 1 1 23 59 59))))
|
||||
|
||||
(test-assert "weeknums 1/1/70 != 10/1/70"
|
||||
(not (weeknums-equal? (cons '(1970 1 1 0 0 0)
|
||||
'(1970 1 10 0 0 1)))))
|
||||
|
||||
(test-assert "weeknum 28/12/69 != 5/1/70"
|
||||
(not (weeknums-equal? (cons '(1969 12 28 0 0 1)
|
||||
'(1970 1 5 0 0 1))))))
|
||||
|
||||
(define (test-date-get-quarter-string)
|
||||
(and (or (string=? "Q1" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
|
||||
(begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (creaete-datevec '(2001 2 14 11 42 23))))
|
||||
#f))
|
||||
(or (string=? "Q2" (gnc:date-get-quarter-string (create-datevec '(2013 4 23 18 11 49))))
|
||||
(begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
|
||||
#f))
|
||||
(or (string=? "Q3" (gnc:date-get-quarter-string (create-datevec '(1997 9 11 08 14 21))))
|
||||
(begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23)))))
|
||||
#f)))
|
||||
|
||||
(test-equal "14/02/2001 = Q1"
|
||||
"Q1"
|
||||
(gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
|
||||
|
||||
(test-equal "23/04/2013 = Q2"
|
||||
"Q2"
|
||||
(gnc:date-get-quarter-string (create-datevec '(2013 4 23 18 11 49))))
|
||||
|
||||
(test-equal "11/09/1997 = Q3"
|
||||
"Q3"
|
||||
(gnc:date-get-quarter-string (create-datevec '(1997 9 11 08 14 21)))))
|
||||
|
Loading…
Reference in New Issue
Block a user