2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2010 John Benediktsson
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-06 12:32:15 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: arrays assocs calendar io io.encodings.binary io.sockets
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.timeouts kernel math math.functions memcached
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								memcached.private namespaces present sequences sorting system
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 13:50:16 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								threads tools.test ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: memcached.tests
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-06 12:32:15 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Use a version of with-memcached that sets a timeout
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: with-memcached ( quot -- )
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-06 13:21:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ 5 seconds input-stream get set-timeout ] prepose
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    memcached:with-memcached ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-06 12:32:15 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: not-found? ( quot -- )
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ key-not-found? ] must-fail-with ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: x ( -- str ) cpu present "-x" append ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: y ( -- str ) cpu present "-y" append ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: z ( -- str ) cpu present "-z" append ;
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test version
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [ [ m/version ] with-memcached length 0 > ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test simple set get
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "valuex" x m/set ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "valuex" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test flush
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "valuex" x m/set "valuey" y m/set ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "valuex" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ "valuey" } [ [ y m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ [ x m/get ] with-memcached ] not-found?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ [ y m/get ] with-memcached ] not-found?
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test noop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/noop ] with-memcached
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test delete
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "valuex" x m/set ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "valuex" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ x m/delete ] with-memcached
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ [ x m/get ] with-memcached ] not-found?
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test replace
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ [ x m/get ] with-memcached ] not-found?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ [ "ex" x m/replace ] with-memcached ] not-found?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "ex" x m/add ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "ex" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "ex2" x m/replace ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "ex2" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test incr
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ 0 } [ [ x m/incr ] with-memcached ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ 1 } [ [ x m/incr ] with-memcached ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ 212 } [ [ 211 x m/incr-val ] with-memcached ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ 8589934804 } [ [ 2 33 ^ x m/incr-val ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test decr
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "5" x m/set ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ 4 } [ [ x m/decr ] with-memcached ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ 0 } [ [ 211 x m/decr-val ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test timebombed flush
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ [ x m/get ] with-memcached ] not-found?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "valuex" x m/set ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "valuex" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ 2 m/flush-later ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "valuex" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								3 seconds sleep
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ [ x m/get ] with-memcached ] not-found?
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test append
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "some" x m/set ] with-memcached
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "thing" x m/append ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "something" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test prepend
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "some" x m/set ] with-memcached
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "thing" x m/prepend ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "thingsome" } [ [ x m/get ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-08-19 16:11:24 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! test multi-get
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ m/flush ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ H{ } } [ [ x y z 3array m/getseq ] with-memcached ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ "5" x m/set ] with-memcached
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "valuex" y m/set ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ { "5" "valuex" } } [
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 13:50:16 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ x y z 3array m/getseq values natural-sort ] with-memcached
							 | 
						
					
						
							
								
									
										
										
										
											2011-09-02 00:26:09 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 |