| 
									
										
										
										
											2015-07-20 12:32:31 -04:00
										 |  |  | USING: accessors compiler.cfg.debugger | 
					
						
							|  |  |  | compiler.cfg.loop-detection compiler.cfg.loop-detection.private | 
					
						
							|  |  |  | compiler.cfg.utilities kernel namespaces sequences sets | 
					
						
							|  |  |  | tools.test ;
 | 
					
						
							| 
									
										
										
										
											2009-08-13 20:21:44 -04:00
										 |  |  | IN: compiler.cfg.loop-detection.tests | 
					
						
							| 
									
										
										
										
											2015-04-21 16:45:38 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | { V{ 0 } { 1 } } [ | 
					
						
							|  |  |  |     V{ } 0 insns>block V{ } 1 insns>block [ connect-bbs ] keep
 | 
					
						
							|  |  |  |     f f <natural-loop> [ process-loop-block ] keep
 | 
					
						
							| 
									
										
										
										
											2015-07-20 12:32:31 -04:00
										 |  |  |     blocks>> members | 
					
						
							| 
									
										
										
										
											2015-04-21 16:45:38 -04:00
										 |  |  |     [ [ number>> ] map ] bi@
 | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! process-loop-ends | 
					
						
							|  |  |  | { } [ | 
					
						
							|  |  |  |     f f <natural-loop> process-loop-ends | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-08-08 01:24:46 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | V{ } 0 test-bb | 
					
						
							|  |  |  | V{ } 1 test-bb | 
					
						
							|  |  |  | V{ } 2 test-bb | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 0 { 1 2 } edges | 
					
						
							|  |  |  | 2 0 edge | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-11-07 13:02:14 -05:00
										 |  |  | : test-loop-detection ( -- )
 | 
					
						
							| 
									
										
										
										
											2014-12-11 15:48:43 -05:00
										 |  |  |     0 get block>cfg needs-loops ;
 | 
					
						
							| 
									
										
										
										
											2009-08-08 01:24:46 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { } [ test-loop-detection ] unit-test | 
					
						
							| 
									
										
										
										
											2009-08-08 01:24:46 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { 1 } [ 0 get loop-nesting-at ] unit-test | 
					
						
							|  |  |  | { 0 } [ 1 get loop-nesting-at ] unit-test | 
					
						
							|  |  |  | { 1 } [ 2 get loop-nesting-at ] unit-test |