| 
									
										
										
										
											2008-03-01 17:00:45 -05:00
										 |  |  | IN: assocs.tests | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | USING: kernel math namespaces tools.test vectors sequences | 
					
						
							|  |  |  | sequences.private hashtables io prettyprint assocs | 
					
						
							|  |  |  | continuations ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-05-01 21:01:57 -04:00
										 |  |  | [ t ] [ H{ } dup assoc-subset? ] unit-test | 
					
						
							|  |  |  | [ f ] [ H{ { 1 3 } } H{ } assoc-subset? ] unit-test | 
					
						
							|  |  |  | [ t ] [ H{ } H{ { 1 3 } } assoc-subset? ] unit-test | 
					
						
							|  |  |  | [ t ] [ H{ { 1 3 } } H{ { 1 3 } } assoc-subset? ] unit-test | 
					
						
							|  |  |  | [ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } assoc-subset? ] unit-test | 
					
						
							|  |  |  | [ f ] [ H{ { 1 f } } H{ } assoc-subset? ] unit-test | 
					
						
							|  |  |  | [ t ] [ H{ { 1 f } } H{ { 1 f } } assoc-subset? ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | ! Test some combinators | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     { 4 14 32 } | 
					
						
							|  |  |  | ] [ | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         H{ | 
					
						
							|  |  |  |             { 1 2 } | 
					
						
							|  |  |  |             { 3 4 } | 
					
						
							|  |  |  |             { 5 6 } | 
					
						
							|  |  |  |         } [ * 2 + , ] assoc-each
 | 
					
						
							|  |  |  |     ] { } make | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ t ] [ H{ } [ 2drop f ] assoc-all? ] unit-test | 
					
						
							|  |  |  | [ t ] [ H{ { 1 1 } } [ = ] assoc-all? ] unit-test | 
					
						
							|  |  |  | [ f ] [ H{ { 1 2 } } [ = ] assoc-all? ] unit-test | 
					
						
							|  |  |  | [ t ] [ H{ { 1 1 } { 2 2 } } [ = ] assoc-all? ] unit-test | 
					
						
							|  |  |  | [ f ] [ H{ { 1 2 } { 2 2 } } [ = ] assoc-all? ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-26 00:12:44 -04:00
										 |  |  | [ H{ } ] [ H{ { t f } { f t } } [ 2drop f ] assoc-filter ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [ | 
					
						
							|  |  |  |     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } | 
					
						
							| 
									
										
										
										
											2008-04-26 00:12:44 -04:00
										 |  |  |     [ drop 3 >= ] assoc-filter
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ 21 ] [ | 
					
						
							|  |  |  |     0 H{ | 
					
						
							|  |  |  |         { 1 2 } | 
					
						
							|  |  |  |         { 3 4 } | 
					
						
							|  |  |  |         { 5 6 } | 
					
						
							|  |  |  |     } [ | 
					
						
							|  |  |  |         + +
 | 
					
						
							|  |  |  |     ] assoc-each
 | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | H{ } clone "cache-test" set
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test | 
					
						
							|  |  |  | [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test | 
					
						
							|  |  |  | [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test | 
					
						
							|  |  |  | [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     H{ { "factor" "rocks" } { 3 4 } } | 
					
						
							|  |  |  | ] [ | 
					
						
							|  |  |  |     H{ { "factor" "rocks" } { "dup" "sq" } { 3 4 } } | 
					
						
							|  |  |  |     H{ { "factor" "rocks" } { 1 2 } { 2 3 } { 3 4 } } | 
					
						
							| 
									
										
										
										
											2008-04-13 23:58:07 -04:00
										 |  |  |     assoc-intersect
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     H{ { 1 2 } { 2 3 } { 6 5 } } | 
					
						
							|  |  |  | ] [ | 
					
						
							|  |  |  |     H{ { 2 4 } { 6 5 } } H{ { 1 2 } { 2 3 } } | 
					
						
							| 
									
										
										
										
											2008-04-13 23:58:07 -04:00
										 |  |  |     assoc-union
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ H{ { 1 2 } { 2 3 } } t ] [ | 
					
						
							| 
									
										
										
										
											2008-04-13 23:58:07 -04:00
										 |  |  |     f H{ { 1 2 } { 2 3 } } [ assoc-union ] 2keep swap assoc-union dupd =
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     H{ { 1 f } } | 
					
						
							|  |  |  | ] [ | 
					
						
							| 
									
										
										
										
											2008-04-13 23:58:07 -04:00
										 |  |  |     H{ { 1 f } } H{ { 1 f } } assoc-intersect
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ { 1 3 } ] [ H{ { 2 2 } } { 1 2 3 } remove-all ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ H{ { "hi" 2 } { 3 4 } } ] | 
					
						
							|  |  |  | [ "hi" 1 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ] | 
					
						
							|  |  |  | unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ H{ { 1 2 } { 3 4 } } ] | 
					
						
							|  |  |  | [ "hi" 5 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ] | 
					
						
							|  |  |  | unit-test | 
					
						
							| 
									
										
										
										
											2007-12-03 19:29:16 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     H{ { 1.0 1.0 } { 2.0 2.0 } } | 
					
						
							|  |  |  | ] [ | 
					
						
							|  |  |  |     F{ 1.0 2.0 } [ dup ] H{ } map>assoc
 | 
					
						
							|  |  |  | ] unit-test | 
					
						
							| 
									
										
										
										
											2008-03-26 04:57:48 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | [ { 3 } ] [ | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         3
 | 
					
						
							|  |  |  |         H{ } clone
 | 
					
						
							|  |  |  |         2 [ | 
					
						
							| 
									
										
										
										
											2008-03-27 06:13:52 -04:00
										 |  |  |             2dup [ , f ] cache drop
 | 
					
						
							| 
									
										
										
										
											2008-03-26 04:57:48 -04:00
										 |  |  |         ] times
 | 
					
						
							|  |  |  |         2drop
 | 
					
						
							| 
									
										
										
										
											2008-03-27 06:13:52 -04:00
										 |  |  |     ] { } make | 
					
						
							| 
									
										
										
										
											2008-03-26 04:57:48 -04:00
										 |  |  | ] unit-test |