| 
									
										
										
										
											2008-07-06 00:08:30 -04:00
										 |  |  | USING: arrays generic kernel math models models.compose | 
					
						
							| 
									
										
										
										
											2008-09-02 02:53:43 -04:00
										 |  |  | namespaces sequences assocs accessors tools.test ;
 | 
					
						
							|  |  |  | IN: models.tests | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | TUPLE: model-tester hit? ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-04-13 16:06:27 -04:00
										 |  |  | : <model-tester> model-tester new ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-02 02:53:43 -04:00
										 |  |  | M: model-tester model-changed nip t >>hit? drop ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | [ T{ model-tester f t } ] | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     T{ model-tester f f } 3 <model> 2dup add-connection | 
					
						
							|  |  |  |     5 swap set-model | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 3 <model> "model-a" set
 | 
					
						
							|  |  |  | 4 <model> "model-b" set
 | 
					
						
							|  |  |  | "model-a" get "model-b" get 2array <compose> "model-c" set
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | "model-c" get activate-model | 
					
						
							| 
									
										
										
										
											2008-09-02 02:53:43 -04:00
										 |  |  | [ { 3 4 } ] [ "model-c" get value>>  ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | "model-c" get deactivate-model | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | T{ model-tester f f } "tester" set
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ T{ model-tester f t } { 6 4 } ] | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     "tester" get "model-c" get add-connection | 
					
						
							|  |  |  |     6 "model-a" get set-model | 
					
						
							|  |  |  |     "tester" get
 | 
					
						
							| 
									
										
										
										
											2008-09-02 02:53:43 -04:00
										 |  |  |     "model-c" get value>> | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test |