2007-09-20 18:09:08 -04:00
|
|
|
USING: compiler tools.test namespaces sequences
|
|
|
|
kernel.private kernel math continuations continuations.private
|
2008-09-02 02:53:01 -04:00
|
|
|
words splitting grouping sorting accessors ;
|
2009-08-13 20:21:44 -04:00
|
|
|
IN: compiler.tests.stack-trace
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: symbolic-stack-trace ( -- newseq )
|
2008-09-02 02:53:01 -04:00
|
|
|
error-continuation get call>> callstack>array
|
2010-02-01 02:08:24 -05:00
|
|
|
3 group flip first ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-06-08 16:32:55 -04:00
|
|
|
: foo ( -- * ) 3 throw 7 ;
|
|
|
|
: bar ( -- * ) foo 4 ;
|
|
|
|
: baz ( -- * ) bar 5 ;
|
2008-02-06 14:47:19 -05:00
|
|
|
[ baz ] [ 3 = ] must-fail-with
|
2007-09-28 00:26:58 -04:00
|
|
|
[ t ] [
|
|
|
|
symbolic-stack-trace
|
2009-08-18 04:49:05 -04:00
|
|
|
2 head*
|
2009-03-18 18:01:26 -04:00
|
|
|
{ baz bar foo } tail?
|
2007-09-20 18:09:08 -04:00
|
|
|
] unit-test
|
|
|
|
|
2008-06-08 16:32:55 -04:00
|
|
|
: bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-10-28 16:02:00 -04:00
|
|
|
: stack-trace-any? ( word -- ? ) symbolic-stack-trace member-eq? ;
|
2007-09-28 00:26:58 -04:00
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
[ t ] [
|
2009-01-29 23:19:07 -05:00
|
|
|
[ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-any?
|
2007-09-20 18:09:08 -04:00
|
|
|
] unit-test
|
2009-08-18 04:49:05 -04:00
|
|
|
|
2007-10-14 21:13:42 -04:00
|
|
|
[ t f ] [
|
2008-02-06 14:47:19 -05:00
|
|
|
[ { "hi" } bleh ] ignore-errors
|
2009-01-29 23:19:07 -05:00
|
|
|
\ + stack-trace-any?
|
|
|
|
\ > stack-trace-any?
|
2007-09-20 18:09:08 -04:00
|
|
|
] unit-test
|