| 
									
										
										
										
											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
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { } [ my-mailbox data>> clear-deque ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -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 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { 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
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -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 |