Port cal-period tests.
This commit is contained in:
		
							parent
							
								
									95640fbff7
								
							
						
					
					
						commit
						dc47cfe36b
					
				
					 1 changed files with 75 additions and 37 deletions
				
			
		|  | @ -223,69 +223,107 @@ | |||
|  ;; Performs self-tests of the period module. | ||||
|  (define (cal-period-tests!) | ||||
|    (run-tests | ||||
|     period | ||||
|     cal-period | ||||
|     (test-equal? sort-period-markers | ||||
| 		 (sort-period-markers | ||||
| 		  `((start ,(make-cal-month 2023 1)) | ||||
| 		    (stop ,(make-cal-month 2022 10)) | ||||
| 		    (start ,(make-cal-month 2022 3)))) | ||||
| 		 '((start (2022 3)) (stop (2022 10)) (start (2023 1)))) | ||||
| 		 `((start ,(make-cal-month 2022 3)) | ||||
| 		   (stop ,(make-cal-month 2022 10)) | ||||
| 		   (start ,(make-cal-month 2023 1)))) | ||||
|     (test-equal? period-markers->cal-periods | ||||
| 	         (period-markers->cal-periods | ||||
| 		  '((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)))) | ||||
| 		 '(#t | ||||
| 		   (((2022 3) (2022 10) #f #f) | ||||
| 		    ((2023 1) (2023 4) #f #f)) | ||||
| 		  `((start ,(make-cal-month 2022 3)) | ||||
| 		    (stop ,(make-cal-month 2022 10)) | ||||
| 		    (start ,(make-cal-month 2023 1)) | ||||
| 		    (stop ,(make-cal-month 2023 4)))) | ||||
| 		 `(#t | ||||
| 		   (,(make-cal-period (make-cal-month 2022 3) | ||||
| 				      (make-cal-month 2022 10) #f #f) | ||||
| 		    ,(make-cal-period (make-cal-month 2023 1) | ||||
| 				      (make-cal-month 2023 4) #f #f)) | ||||
| 		   "" | ||||
| 		   -1)) | ||||
|     (test-equal? period-markers->cal-periods-open | ||||
| 	         (period-markers->cal-periods | ||||
| 		  '((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)) (start (2023 5)))) | ||||
| 		 '(#t | ||||
| 		   (((2022 3) (2022 10) #f #f) | ||||
| 		    ((2023 1) (2023 4) #f #f) | ||||
| 		    ((2023 5) #f #f #f)) | ||||
| 		  `((start ,(make-cal-month 2022 3)) | ||||
| 		    (stop ,(make-cal-month 2022 10)) | ||||
| 		    (start ,(make-cal-month 2023 1)) | ||||
| 		    (stop ,(make-cal-month 2023 4)) | ||||
| 		    (start ,(make-cal-month 2023 5)))) | ||||
| 		 `(#t | ||||
| 		   (,(make-cal-period (make-cal-month 2022 3) | ||||
| 				      (make-cal-month 2022 10) #f #f) | ||||
| 		    ,(make-cal-period (make-cal-month 2023 1) | ||||
| 				      (make-cal-month 2023 4) #f #f) | ||||
| 		    ,(make-cal-period (make-cal-month 2023 5) #f #f #f)) | ||||
| 		   "" | ||||
| 		   -1)) | ||||
|     (test-eq? cal-period->duration | ||||
| 	      (cal-period->duration '((2023 1) (2023 4) #f #f)) 3) | ||||
|     (parameterize ((*current-month* (list 2023 4))) | ||||
| 	      (cal-period->duration (make-cal-period (make-cal-month 2023 1) | ||||
| 						     (make-cal-month 2023 4) #f #f)) | ||||
| 	      3) | ||||
|     (parameterize ((*current-month* (make-cal-month 2023 4))) | ||||
|       (test-eq? cal-period->duration | ||||
| 		(cal-period->duration '((2023 1) #f #f #f)) 3)) | ||||
| 		(cal-period->duration (make-cal-period (make-cal-month 2023 1) #f #f #f)) | ||||
| 		3)) | ||||
|     (test-eq? cal-periods-duration | ||||
| 	      (cal-periods-duration '(((2022 3) (2022 10) #f #f) | ||||
| 				  ((2023 1) (2023 4) #f #f))) | ||||
| 	      (cal-periods-duration `(,(make-cal-period (make-cal-month 2022 3) | ||||
| 							(make-cal-month 2022 10) #f #f) | ||||
| 				      ,(make-cal-period (make-cal-month 2023 1) | ||||
| 							(make-cal-month 2023 4) #f #f))) | ||||
| 	      10) | ||||
|     (test-true cal-month-in-period? | ||||
| 	       (cal-month-in-period? '((2022 1) (2022 4) #f #f) '(2022 3))) | ||||
| 	       (cal-month-in-period? (make-cal-period (make-cal-month 2022 1) | ||||
| 						      (make-cal-month 2022 4) #f #f) | ||||
| 				     (make-cal-month 2022 3))) | ||||
|     (test-false cal-month-in-period? | ||||
| 		(cal-month-in-period? '((2022 1) (2022 4) #f #f) '(2022 5))) | ||||
| 		(cal-month-in-period? (make-cal-period (make-cal-month 2022 1) | ||||
| 						       (make-cal-month 2022 4) #f #f) | ||||
| 				      (make-cal-month 2022 5))) | ||||
|     (test-true cal-month-in-periods? | ||||
| 	       (cal-month-in-periods? '(((2022 1) (2022 4) #f #f) | ||||
| 				    ((2023 5) (2023 10) #f #f)) | ||||
| 				  '(2022 3))) | ||||
| 	       (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) | ||||
| 							  (make-cal-month 2022 4) #f #f) | ||||
| 					,(make-cal-period (make-cal-month 2023 5) | ||||
| 							  (make-cal-month 2023 10) #f #f)) | ||||
| 				      (make-cal-month 2022 3))) | ||||
|     (test-true cal-month-in-periods? | ||||
| 	       (cal-month-in-periods? '(((2022 1) (2022 4) #f #f) | ||||
| 				    ((2023 5) (2023 10) #f #f)) | ||||
| 				  '(2023 7))) | ||||
| 	       (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) | ||||
| 							  (make-cal-month 2022 4) #f #f) | ||||
| 					,(make-cal-period (make-cal-month 2023 5) | ||||
| 							  (make-cal-month 2023 10) #f #f)) | ||||
| 				      (make-cal-month 2023 7))) | ||||
|     (test-false cal-month-in-periods? | ||||
| 		(cal-month-in-periods? '(((2022 1) (2022 4) #f #f) | ||||
| 				     ((2023 5) (2023 10) #f #f)) | ||||
| 				   '(2022 10))) | ||||
| 		(cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) | ||||
| 							   (make-cal-month 2022 4) #f #f) | ||||
| 					 ,(make-cal-period (make-cal-month 2023 5) | ||||
| 							   (make-cal-month 2023 10) #f #f)) | ||||
| 				       (make-cal-month 2022 10))) | ||||
|     (test-equal? cal-period->string | ||||
| 		 (cal-period->string '((2022 1) (2022 4) #f #f)) | ||||
| 		 (cal-period->string (make-cal-period (make-cal-month 2022 1) | ||||
| 						      (make-cal-month 2022 4) #f #f)) | ||||
| 		 "2022-01..2022-04") | ||||
|     (test-equal? cal-periods->string | ||||
| 	         (cal-periods->string '(((2022 1) (2022 4) #f #f) | ||||
| 				    ((2022 12) (2023 2) #f #f))) | ||||
| 	         (cal-periods->string `(,(make-cal-period (make-cal-month 2022 1) | ||||
| 							  (make-cal-month 2022 4) #f #f) | ||||
| 					,(make-cal-period (make-cal-month 2022 12) | ||||
| 							  (make-cal-month 2023 2) #f #f))) | ||||
| 		 "2022-01..2022-04, 2022-12..2023-02") | ||||
|     (test-false cal-periods-match (cal-periods-match '(((2022 1) (2022 4) #f #f) | ||||
| 					       ((2022 12) (2023 2) #f #f)) | ||||
| 					     '(2022 5))) | ||||
|     (test-equal? cal-periods-match (cal-periods-match '(((2022 1) (2022 4) #f #f) | ||||
| 						((2022 12) (2023 2) #f #f)) | ||||
| 					      '(2022 2)) | ||||
| 		 '((2022 1) (2022 4) #f #f)) | ||||
|     (test-false cal-periods-match | ||||
| 		(cal-periods-match `(,(make-cal-period (make-cal-month 2022 1) | ||||
| 						       (make-cal-month 2022 4) #f #f) | ||||
| 				     ,(make-cal-period (make-cal-month 2022 12) | ||||
| 						       (make-cal-month 2023 2) #f #f)) | ||||
| 				   (make-cal-month 2022 5))) | ||||
|     (test-equal? cal-periods-match | ||||
| 		 (cal-periods-match `(,(make-cal-period (make-cal-month 2022 1) | ||||
| 							(make-cal-month 2022 4) #f #f) | ||||
| 				      ,(make-cal-period (make-cal-month 2022 12) | ||||
| 							(make-cal-month 2023 2) #f #f)) | ||||
| 				    (make-cal-month 2022 2)) | ||||
| 		 (make-cal-period (make-cal-month 2022 1) | ||||
| 				  (make-cal-month 2022 4) #f #f)) | ||||
|     )) | ||||
| 
 | ||||
|  ) | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue