| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: temporary | 
					
						
							|  |  |  | USING: compiler tools.test namespaces sequences | 
					
						
							|  |  |  | kernel.private kernel math continuations continuations.private | 
					
						
							| 
									
										
										
										
											2007-09-28 00:26:58 -04:00
										 |  |  | words splitting ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : symbolic-stack-trace ( -- newseq )
 | 
					
						
							| 
									
										
										
										
											2007-09-28 00:26:58 -04:00
										 |  |  |     error-continuation get continuation-call callstack>array
 | 
					
						
							|  |  |  |     2 group flip first ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : foo 3 throw 7 ;
 | 
					
						
							|  |  |  | : bar foo 4 ;
 | 
					
						
							|  |  |  | : baz bar 5 ;
 | 
					
						
							|  |  |  | \ baz compile | 
					
						
							|  |  |  | [ 3 ] [ [ baz ] catch ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-28 00:26:58 -04:00
										 |  |  | [ t ] [ | 
					
						
							|  |  |  |     symbolic-stack-trace | 
					
						
							|  |  |  |     [ word? ] subset | 
					
						
							|  |  |  |     { baz bar foo throw } tail?
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bleh [ 3 + ] map [ 0 > ] subset ;
 | 
					
						
							|  |  |  | \ bleh compile | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : stack-trace-contains? symbolic-stack-trace memq? ;
 | 
					
						
							| 
									
										
										
										
											2007-09-28 00:26:58 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | [ t ] [ | 
					
						
							|  |  |  |     [ { 1 "hi" } bleh ] catch drop \ + stack-trace-contains? | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  |      | 
					
						
							| 
									
										
										
										
											2007-10-14 21:13:42 -04:00
										 |  |  | [ t f ] [ | 
					
						
							|  |  |  |     [ { "hi" } bleh ] catch drop
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     \ + stack-trace-contains? | 
					
						
							|  |  |  |     \ > stack-trace-contains? | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : quux [ t [ "hi" throw ] when ] times ;
 | 
					
						
							|  |  |  | \ quux compile | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ t ] [ | 
					
						
							|  |  |  |     [ 10 quux ] catch drop
 | 
					
						
							|  |  |  |     \ (each-integer) stack-trace-contains? | 
					
						
							|  |  |  | ] unit-test |