mirror of
				https://github.com/Gnucash/gnucash.git
				synced 2025-02-25 18:55:30 -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:
		| @@ -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))))) | ||||
|   | ||||
		Reference in New Issue
	
	Block a user