2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2005 Chris Double. All Rights Reserved.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-11 01:20:06 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: kernel threads vectors arrays sequences namespaces make
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								tools.test continuations deques strings math words match
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								quotations concurrency.messaging concurrency.mailboxes
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-14 08:53:54 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								concurrency.count-downs accessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-01 17:00:45 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: concurrency.messaging.tests
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-30 22:58:11 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ ] [ my-mailbox data>> clear-deque ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "received" ] [ 
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        receive "received" swap reply-synchronous
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] "Synchronous test" spawn
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "sent" swap send-synchronous
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ 1 3 2 ] [
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    1 self send
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    2 self send
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    3 self send
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    receive
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ 2 mod 0 = not ] receive-if
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    receive
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-06 14:47:19 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "crash" throw
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] "Linked test" spawn-linked drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    receive
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-14 08:53:54 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] [ error>> "crash" = ] must-fail-with
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								MATCH-VARS: ?from ?to ?value ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: increment
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: decrement
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: value
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: exit
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: counter ( value -- value ? )
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    receive {
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { { increment ?value } [ ?value + t ] }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { { decrement ?value } [ ?value - t ] }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { { value ?from }      [ dup ?from send t ] }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { exit                 [ f ] }
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    } match-cond ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ -5 ] [
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-18 20:22:59 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ 0 [ counter ] loop ] "Counter" spawn "counter" set
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { increment 10 } "counter" get send
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    { decrement 15 } "counter" get send
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ value , self , ] { } make "counter" get send
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    receive
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    exit "counter" get send
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Not yet
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! 1 <count-down> "c" set
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!     "c" get count-down
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!     receive drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! ] "Bad synchronous send" spawn "t" set
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-19 15:06:20 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! [ 3 "t" get send-synchronous ] must-fail
							 |