File Coverage

blib/lib/Trace/Mask/Test.pm
Criterion Covered Total %
statement 107 120 89.1
branch 29 46 63.0
condition 14 39 35.9
subroutine 12 12 100.0
pod 2 2 100.0
total 164 219 74.8


line stmt bran cond sub pod time code
1             package Trace::Mask::Test;
2 3     3   190294 use strict;
  3         7  
  3         77  
3 3     3   16 use warnings;
  3         6  
  3         82  
4              
5 3     3   546 use Trace::Mask::Util qw/mask_frame mask_line mask_call/;
  3         21  
  3         191  
6 3     3   1069 use Trace::Mask::Reference qw/trace/;
  3         7  
  3         177  
7              
8 3     3   16 use Carp qw/croak/;
  3         5  
  3         131  
9 3     3   15 use Scalar::Util qw/reftype/;
  3         6  
  3         118  
10 3     3   25 use List::Util qw/min/;
  3         6  
  3         177  
11              
12 3     3   13 use base 'Exporter';
  3         6  
  3         14886  
13             our @EXPORT = qw{test_tracer NA};
14             our @EXPORT_OK = qw{
15             test_stack_hide test_stack_shift test_stack_stop test_stack_no_start
16             test_stack_alter test_stack_shift_and_hide test_stack_shift_short
17             test_stack_hide_short test_stack_shift_and_alter test_stack_full_combo
18             test_stack_restart test_stack_special test_stack_lock
19             };
20              
21 861     861 1 3442 sub NA() { \&NA }
22              
23             sub test_tracer {
24 11     11 1 23321 my %params = @_;
25 11         30 my $convert = delete $params{convert};
26 11         34 my $trace = delete $params{trace};
27 11   50     41 my $name = delete $params{name} || 'tracer test';
28 11   100     81 my $type = delete $params{type} || 'return';
29              
30 11 50 33     144 croak "your must provide a 'convert' callback coderef"
      33        
31             unless $convert && ref($convert) && reftype($convert) eq 'CODE';
32              
33 11 50 33     106 croak "your must provide a 'trace' callback coderef"
      33        
34             unless $trace && ref($trace) && reftype($trace) eq 'CODE';
35              
36 11         16 my %tests;
37 11 50       38 if (keys %params) {
38 0         0 my @bad;
39              
40 0         0 for my $test (keys %params) {
41 0         0 my $sub;
42 0 0 0     0 $sub = __PACKAGE__->can($test) if !ref($test) && $test =~ m/^test_/ && $test !~ m/test_tracer/;
      0        
43 0 0 0     0 if($sub && ref($sub) && reftype($sub) eq 'CODE') {
      0        
44 0         0 $tests{$test} = $sub;
45             }
46             else{
47 0         0 push @bad => $test;
48             }
49             }
50              
51 0 0       0 croak "Invalid test(s): " . join(', ', map {"'$_'"} sort @bad)
  0         0  
52             if @bad;
53             }
54             else {
55 11         440 for my $sym (keys %Trace::Mask::Test::) {
56 1296 100       2886 next unless $sym =~ m/^test_/;
57 154 100       356 next if $sym =~ m/test_tracer/;
58 143   50     740 my $sub = __PACKAGE__->can($sym) || next;
59 143         392 $tests{$sym} = $sub;
60             }
61             }
62              
63 11         187 require Test::Stream::Plugin::Compare;
64 11         1387 require Test::Stream::Plugin::Subtest;
65 11         4816 require Test::Stream::Context;
66              
67 11         38 my $ctx = Test::Stream::Context::context();
68              
69 11         1275 my $results = {};
70 11         21 my $expects = {};
71 11         18 my $ok;
72 11         34 my $sig_die = $SIG{__DIE__};
73              
74             Test::Stream::Plugin::Subtest::subtest_buffered($name => sub {
75 11     11   6731 local $SIG{__DIE__} = $sig_die;
76 11         38 my $sctx = Test::Stream::Context::context();
77 11         1351 $sctx->set_debug($ctx->debug);
78 11         199 for my $test (sort keys %tests) {
79 143         136517 my $sub = $tests{$test};
80 143         192 my $result;
81             {
82 143         259 my ($ok, $error, $out, $warning);
  143         220  
83             {
84 143         187 local $@;
  143         209  
85 143         698 local $SIG{__WARN__} = $SIG{__WARN__};
86 143         324 local *STDERR = *STDERR;
87              
88 143 100       606 if ($type eq 'warning') {
    100          
89             $SIG{__WARN__} = sub {
90 26 50       73 die "Got multiple warnings!\n$warning\n$_[0]\n" if $warning;
91 26         263 ($warning) = @_;
92 26         140 };
93             }
94             elsif($type eq 'sigwarn') {
95 26         70 local *Trace::Mask::Test::FAKE;
96 26         60 *STDERR = *Trace::Mask::Test::FAKE;
97 26         48 $warning = "";
98 1 50   1   1108 open(STDERR, '>', \$warning) || do {
  1         11  
  1         6  
  26         390  
99 0         0 print "Could not open temp STDERR: $!\n";
100 0         0 die "Could not open temp STDERR: $!";
101             };
102             }
103              
104 143         1441 $ok = eval { $out = $sub->($trace); 1 };
  143         658  
  91         248  
105 143         841 $error = $@;
106             }
107              
108 143 100 66     648 if ($type eq 'exception') {
    100          
    50          
109 52 50       136 die "Callback did not throw an exception!\n" if $ok;
110 52         117 $ok = 1;
111 52         122 $result = $error;
112             }
113             elsif ($type eq 'return') {
114 39 50       80 die "Callback did not return anything!\n" unless $out;
115 39         69 $result = $out;
116             }
117             elsif($type eq 'warning' || $type eq 'sigwarn') {
118 52 50       131 die "Callback did not issue any warnings!\n" unless $warning;
119 52         99 $result = $warning;
120             }
121             else {
122 0         0 die "Invalid type: '$type'\n";
123             }
124              
125 143 50       302 die $error unless $ok;
126              
127 143         471 $result = $convert->($result);
128             }
129 143         2989 my $expect = $sub->(\&trace);
130              
131 143         516 $results->{$test} = $result;
132 143         378 $expects->{$test} = $expect;
133              
134 143         554 my $size = min(scalar(@$result), scalar(@$expect));
135 143         445 for(my $i = 0; $i < $size; $i++) { # Frame
136 792         1559 delete $expect->[$i]->[2]; # Remove the mask
137              
138             # Args may not be available
139 792 100 66     1856 unless ($result->[$i]->[1] && @{$result->[$i]->[1]}) {
  792         2964  
140 250         411 delete $expect->[$i]->[1];
141 250         384 delete $result->[$i]->[1];
142             }
143              
144 792         1011 for (my $j = @{$expect->[$i]->[0]} - 1; $j >= 0; $j--) {
  792         2287  
145 8712 100       15953 if (exists $result->[$i]->[0]->[$j]) {
146 3602 100 66     18604 $expect->[$i]->[0]->[$j] = sub { 1 } if ref($result->[$i]->[0]->[$j]) && $result->[$i]->[0]->[$j] == \&NA;
  860         546774  
147             }
148             else {
149 5110         5804 pop @{$expect->[$i]->[0]};
  5110         14986  
150             }
151             }
152             }
153              
154 143         600 delete $_->[2] for @$expect;
155 143         666 $ok = Test::Stream::Plugin::Compare::like($result, $expect, $test);
156             }
157 11         11117 $sctx->release;
158 11         113 });
159              
160 11         15480 $ctx->release;
161              
162 11 50       486 return $ok unless wantarray;
163 0           return ($ok, $results, $expects);
164             }
165              
166              
167              
168              
169             #line 1 "mask_test_hide.pl"
170             sub test_stack_hide { # line 1
171             my ($callback) = @_; # line 2
172             mask_frame(stop => 1, hide => 1); # line 3
173             hide_1($callback, 'a'); # line 4
174             } # line 5
175              
176             sub hide_1 { my $code = shift; @_ = (@_); hide_2($code, 'b') } # line 7
177             sub hide_2 { my $code = shift; @_ = (@_); hide_3($code, 'c') } # line 8
178             sub hide_3 { my $code = shift; @_ = (@_); mask_frame(hide => 2); hide_4($code, 'd') } # line 9
179             sub hide_4 { my $code = shift; @_ = (@_); hide_5($code, 'e') } # line 10
180             sub hide_5 { my $code = shift; @_ = (@_); $code->() } # line 11
181              
182              
183              
184              
185             #line 1 "mask_test_shift.pl"
186             sub test_stack_shift { # line 1
187             my ($callback) = @_; # line 2
188             mask_frame(stop => 1, hide => 1); # line 3
189             shift_1($callback, 'a'); # line 4
190             } # line 5
191              
192             sub shift_1 { my $code = shift; @_ = (@_); shift_2($code, 'b') } # line 7
193             sub shift_2 { my $code = shift; @_ = (@_); shift_3($code, 'c') } # line 8
194             sub shift_3 { my $code = shift; @_ = (@_); shift_4($code, 'd') } # line 9
195             sub shift_4 { my $code = shift; @_ = (@_); mask_frame(shift => 2); shift_5($code, 'e') } # line 10
196             sub shift_5 { my $code = shift; @_ = (@_); $code->() } # line 11
197              
198              
199              
200              
201             #line 1 "mask_test_stop.pl"
202             sub test_stack_stop { # line 1
203             my ($callback) = @_; # line 2
204             mask_frame(stop => 1, hide => 1); # line 3
205             stop_1($callback, 'a'); # line 4
206             } # line 5
207              
208             sub stop_1 { my $code = shift; @_ = (@_); stop_2($code, 'b') } # line 7
209             sub stop_2 { my $code = shift; @_ = (@_); mask_frame(stop => 1); stop_3($code, 'c') } # line 8
210             sub stop_3 { my $code = shift; @_ = (@_); stop_4($code, 'd') } # line 9
211             sub stop_4 { my $code = shift; @_ = (@_); stop_5($code, 'e') } # line 10
212             sub stop_5 { my $code = shift; @_ = (@_); $code->() } # line 11
213              
214              
215              
216              
217             #line 1 "mask_test_no_start.pl"
218             sub test_stack_no_start { # line 1
219             my ($callback) = @_; # line 2
220             mask_frame(stop => 1, hide => 1); # line 3
221             no_start_1($callback, 'a'); # line 4
222             } # line 5
223              
224             sub no_start_1 { my $code = shift; @_ = (@_); no_start_2($code, 'b') } # line 7
225             sub no_start_2 { my $code = shift; @_ = (@_); no_start_3($code, 'c') } # line 8
226             sub no_start_3 { my $code = shift; @_ = (@_); no_start_4($code, 'd') } # line 9
227             sub no_start_4 { my $code = shift; @_ = (@_); mask_frame(no_start => 1); no_start_5($code, 'e') } # line 10
228             sub no_start_5 { my $code = shift; @_ = (@_); mask_frame(no_start => 1); mask_call({no_start => 1}, $code) } # line 11
229              
230              
231              
232              
233             #line 1 "mask_test_alter.pl"
234             sub test_stack_alter { # line 1
235             my ($callback) = @_; # line 2
236             mask_frame(stop => 1, hide => 1); # line 3
237             alter_1($callback, 'a'); # line 4
238             } # line 5
239              
240             sub alter_1 { my $code = shift; @_ = (@_); alter_2($code, 'b') } # line 7
241             sub alter_2 { my $code = shift; @_ = (@_); alter_3($code, 'c') } # line 8
242             sub alter_3 { my $code = shift; @_ = (@_); alter_4($code, 'd') } # line 9
243             sub alter_4 { # line 10
244             my $code = shift; # line 11
245             @_ = (@_); # line 12
246             mask_frame( # line 13
247             0 => 'Foo::Bar', # line 14
248             1 => 'Foo/Bar.pm', # line 15
249             2 => '42', # line 16
250             3 => 'Foo::Bar::foobar', # line 17
251             999 => 'x' # line 18
252             ); # line 19
253             alter_5($code, 'e') # line 20
254             } # line 21
255             sub alter_5 { my $code = shift; @_ = (@_); $code->() } # line 22
256              
257              
258              
259              
260             #line 1 "mask_test_s_and_h.pl"
261             sub test_stack_shift_and_hide { # line 1
262             my ($callback) = @_; # line 2
263             mask_frame(stop => 1, hide => 1); # line 3
264             s_and_h_1($callback, 'a'); # line 4
265             } # line 5
266              
267             sub s_and_h_1 { my $code = shift; @_ = (@_); s_and_h_2($code, 'b') } # line 7
268             sub s_and_h_2 { my $code = shift; @_ = (@_); s_and_h_3($code, 'c') } # line 8
269             sub s_and_h_3 { my $code = shift; @_ = (@_); mask_frame(hide => 1); s_and_h_4($code, 'd') } # line 9
270             sub s_and_h_4 { my $code = shift; @_ = (@_); mask_frame(shift => 1); s_and_h_5($code, 'e') } # line 10
271             sub s_and_h_5 { my $code = shift; @_ = (@_); $code->() } # line 11
272              
273              
274              
275              
276             #line 1 "mask_test_shift_short.pl"
277             sub test_stack_shift_short { # line 1
278             my ($callback) = @_; # line 2
279             mask_frame(stop => 1, hide => 1); # line 3
280             shift_short_1($callback, 'a'); # line 4
281             } # line 5
282              
283             sub shift_short_1 { my $code = shift; @_ = (@_); shift_short_2($code, 'b') } # line 7
284             sub shift_short_2 { my $code = shift; @_ = (@_); shift_short_3($code, 'c') } # line 8
285             sub shift_short_3 { my $code = shift; @_ = (@_); shift_short_4($code, 'd') } # line 9
286             sub shift_short_4 { my $code = shift; @_ = (@_); mask_frame(shift => 5); shift_short_5($code, 'e') } # line 10
287             sub shift_short_5 { my $code = shift; @_ = (@_); $code->() } # line 11
288              
289              
290              
291              
292             #line 1 "mask_test_hide_short.pl"
293             sub test_stack_hide_short { # line 1
294             my ($callback) = @_; # line 2
295             mask_frame(stop => 1, hide => 1); # line 3
296             hide_short_1($callback, 'a'); # line 4
297             } # line 5
298              
299             sub hide_short_1 { my $code = shift; @_ = (@_); hide_short_2($code, 'b') } # line 7
300             sub hide_short_2 { my $code = shift; @_ = (@_); hide_short_3($code, 'c') } # line 8
301             sub hide_short_3 { my $code = shift; @_ = (@_); hide_short_4($code, 'd') } # line 9
302             sub hide_short_4 { my $code = shift; @_ = (@_); mask_frame(hide => 5); hide_short_5($code, 'e') } # line 10
303             sub hide_short_5 { my $code = shift; @_ = (@_); $code->() } # line 11
304              
305              
306              
307              
308             #line 1 "mask_test_s_and_a.pl"
309             sub test_stack_shift_and_alter { # line 1
310             my ($callback) = @_; # line 2
311             mask_frame(stop => 1, hide => 1); # line 3
312             s_and_a_1($callback, 'a'); # line 4
313             } # line 5
314              
315             sub s_and_a_1 { my $code = shift; @_ = (@_); s_and_a_2($code, 'b') } # line 7
316             sub s_and_a_2 { my $code = shift; @_ = (@_); s_and_a_3($code, 'c') } # line 8
317             sub s_and_a_3 { # line 9
318             my $code = shift; # line 10
319             @_ = (@_); # line 11
320             mask_frame(0 => 'x', 1 => 'x', 2 => '100', 3 => 'x', 4 => 'x'); # line 12
321             s_and_a_4($code, 'd'); # line 13
322             } # line 14
323             sub s_and_a_4 { # line 15
324             my $code = shift; # line 16
325             @_ = (@_); # line 17
326             mask_frame(0 => 'y', 1 => 'y', 2 => '200', 3 => 'y', 4 => 'y', shift => 1); # line 18
327             s_and_a_5($code, 'e'); # line 19
328             } # line 20
329             sub s_and_a_5 { my $code = shift; @_ = (@_); $code->() } # line 21
330              
331              
332              
333              
334             #line 1 "mask_test_full_combo.pl"
335             sub test_stack_full_combo { # line 1
336             my ($callback) = @_; # line 2
337             mask_frame(stop => 1, hide => 1); # line 3
338             full_combo_1($callback, 'a'); # line 4
339             } # line 5
340              
341             sub full_combo_1 { my $code = shift; @_ = (@_); full_combo_2($code, 'b') } # line 7
342             sub full_combo_2 { my $code = shift; @_ = (@_); mask_frame('stop' => 1, 'restart' => 1); full_combo_3($code, 'c') } # line 8
343             sub full_combo_3 { my $code = shift; @_ = (@_); full_combo_4($code, 'd') } # line 9
344             sub full_combo_4 { my $code = shift; @_ = (@_); mask_frame('stop' => 1); full_combo_5($code, 'e') } # line 10
345             sub full_combo_5 { my $code = shift; @_ = (@_); full_combo_6($code, 'f') } # line 11
346             sub full_combo_6 { my $code = shift; @_ = (@_); full_combo_7($code, 'g') } # line 12
347             sub full_combo_7 { my $code = shift; @_ = (@_); full_combo_8($code, 'h') } # line 13
348             sub full_combo_8 { my $code = shift; @_ = (@_); full_combo_9($code, 'i') } # line 14
349             sub full_combo_9 { my $code = shift; @_ = (@_); mask_frame(0 => 'xxx'); full_combo_10($code, 'j') } # line 15
350             sub full_combo_10 { my $code = shift; @_ = (@_); full_combo_11($code, 'k') } # line 16
351             sub full_combo_11 { my $code = shift; @_ = (@_); full_combo_12($code, 'l') } # line 17
352             sub full_combo_12 { my $code = shift; @_ = (@_); full_combo_13($code, 'm') } # line 18
353             sub full_combo_13 { my $code = shift; @_ = (@_); mask_frame(0 => 'foo', 5 => 'foo'); full_combo_14($code, 'n') } # line 19
354             sub full_combo_14 { my $code = shift; @_ = (@_); mask_frame(hide => 1); full_combo_15($code, 'o') } # line 20
355             sub full_combo_15 { my $code = shift; @_ = (@_); full_combo_16($code, 'p') } # line 21
356             sub full_combo_16 { my $code = shift; @_ = (@_); full_combo_17($code, 'q') } # line 22
357             sub full_combo_17 { my $code = shift; @_ = (@_); mask_frame(shift => 3, 0 => 'bar', 5 => 'bar'); full_combo_18($code, 'r') } # line 23
358             sub full_combo_18 { my $code = shift; @_ = (@_); full_combo_19($code, 's') } # line 24
359             sub full_combo_19 { my $code = shift; @_ = (@_); full_combo_20($code, 't') } # line 25
360             sub full_combo_20 { my $code = shift; @_ = (@_); mask_frame(no_start => 1); mask_call({no_start => 1}, $code) } # line 26
361              
362              
363              
364              
365             #line 1 "mask_test_restart.pl"
366             sub test_stack_restart { # line 1
367             my ($callback) = @_; # line 2
368             mask_frame(stop => 1, hide => 1); # line 3
369             restart_1($callback, 'a'); # line 4
370             } # line 5
371              
372             sub restart_1 { my $code = shift; @_ = (@_); restart_2($code, 'b') } # line 7
373             sub restart_2 { my $code = shift; @_ = (@_); mask_frame('restart' => 1); restart_3($code, 'c') } # line 8
374             sub restart_3 { my $code = shift; @_ = (@_); restart_4($code, 'd') } # line 9
375             sub restart_4 { my $code = shift; @_ = (@_); mask_frame('stop' => 1); restart_5($code, 'e') } # line 10
376             sub restart_5 { my $code = shift; @_ = (@_); restart_6($code, 'f') } # line 11
377             sub restart_6 { my $code = shift; @_ = (@_); mask_call({no_start => 1}, $code) } # line 12
378              
379              
380              
381              
382             #line 1 "mask_test_special.pl"
383             sub test_stack_special { # line 1
384             my ($callback) = @_; # line 2
385             mask_frame(stop => 1, hide => 1); # line 3
386             special_1($callback, 'a'); # line 4
387             } # line 5
388              
389             sub special_1 { my $code = shift; @_ = (@_); special_2($code, 'b') }
390             sub special_2 { my $code = shift; @_ = (@_); unimport($code, 'c') }
391             sub unimport { my $code = shift; @_ = (@_); mask_frame(hide => 1); special_3($code, 'd') }
392             sub special_3 { my $code = shift; @_ = (@_); special_4($code, 'e') }
393             sub special_4 { my $code = shift; @_ = (@_); special_5($code, 'f') }
394             sub special_5 { my $code = shift; @_ = (@_); mask_frame(stop => 1); special_6($code, 'g') }
395             sub special_6 { my $code = shift; @_ = (@_); $code->() }
396              
397              
398              
399              
400             #line 1 "mask_test_lock.pl"
401             sub test_stack_lock { # line 1
402             my ($callback) = @_; # line 2
403             mask_frame(stop => 1, hide => 1); # line 3
404             lock_1($callback, 'a'); # line 4
405             } # line 5
406              
407             sub lock_1 { my $code = shift; @_ = (@_); lock_2($code, 'b') }
408             sub lock_2 { my $code = shift; @_ = (@_); lock_x($code, 'c') }
409             sub lock_x { my $code = shift; @_ = (@_); mask_frame(hide => 1, lock => 1); lock_3($code, 'd') }
410             sub lock_3 { my $code = shift; @_ = (@_); lock_4($code, 'e') }
411             sub lock_4 { my $code = shift; @_ = (@_); lock_5($code, 'f') }
412             sub lock_5 { my $code = shift; @_ = (@_); mask_frame(stop => 1); lock_6($code, 'g') }
413             sub lock_6 { my $code = shift; @_ = (@_); $code->() }
414              
415              
416             1;
417              
418             =pod
419              
420             =head1 NAME
421              
422             Trace::Mask::Test - Tools for testing Trace::Mask compliance.
423              
424             =head1 DESCRIPTION
425              
426             This package provides tools for testing tracers. This allows you to check that
427             a tracer complies with the specifications.
428              
429             =head1 SYNOPSIS
430              
431             use Trace::Mask::Test qw/test_tracer/;
432              
433             test_tracer(
434             name => 'my tracer',
435             trace => \&trace,
436             type => 'return',
437             convert => sub {
438             my $stack = shift;
439             ...
440             return $stack;
441             },
442             );
443              
444             =head1 EXPORTS
445              
446             =over 4
447              
448             =item NA()
449              
450             Placeholder value for use in test_tracer to represent fields the tracer does
451             not provide.
452              
453             =item ($ok, $result, $expect) = test_tracer(trace => \&trace, convert => \&convert, name => "my test")
454              
455             =item ($ok, $result, $expect) = test_tracer(trace => \&trace, convert => \&convert, name => "my test", %tests)
456              
457             This will verify that a tracer follows the specification. This will run every
458             test in the test list below with both the specified tracer and the refewrence
459             tracer, it will then compare the results.
460              
461             In scalar context the sub returns a true or false indicating if the test passed
462             or failed. In List context the sub will return the boolen $ok value, the
463             arrayref produced from your stack, and the arrayref produced by the reference
464             tracer. This behavior gives you the ability to debug the final structures, and
465             manually compare them.
466              
467             =over 4
468              
469             =item name => "..."
470              
471             Specify a name for your test.
472              
473             =item trace => \&trace
474              
475             This should be your tracer, or a subroutine that calls it. This subroutine is
476             called in scalar context. This can return the trace in any form you want so
477             long as it is returned in a scalar.
478              
479             =item convert => \&convert
480              
481             This will be given the scalar your tracer returns as its only input argument.
482             This sub should convert the trace to a standard form for comparison.
483              
484             convert => sub {
485             my ($trace) = @_;
486             ...
487             return [
488             [[$package1, NA(), $line1, $subname1, ...], \@args]
489             [[$package2, $file2, $line2, $subname2, ...], \@args]
490             ]
491             },
492              
493             The standard return is an arrayref with an arrayref for each stack frame. Each
494             frame arrayref should itself contain 2 arrayrefs. The first arrayref should
495             contain the fields caller() would return for that level. The second arrayref
496             should contain arguments that the function was called with. You can use the ref
497             returned from C in place of any value that cannot be obtained from your
498             stack trace results. In addition it only checks values you have specified, if
499             you only list the first 4 fields from caller then only the first 4 are checked.
500              
501             =item type => 'return'
502              
503             The trace function will return a trace in a scalar, use that as our trace.
504              
505             =item type => 'exception'
506              
507             The trace function will throw an exception, intercept it and use the exception
508             as the trace.
509              
510             =item type => 'warning'
511              
512             The trace function will issue a warning, intecept it using a C<$SIG{__WARN__}>
513             override, then use the warning as our trace.
514              
515             B If your tracer issues more than 1 warning and exception will be
516             thrown.
517              
518             B Since this uses a C<$SIG{__WARN__}>, it cannot be used to check traces
519             that require a custom C<$SIG{__WARN__} override. See the 'sigwarn' type below
520             if you are testing a tool that rewrites warnings.
521              
522             =item type => 'sigwarn'
523              
524             The trace function will issue a warning, but a custom $SIG{__WARN__} needs to
525             modify it before we see it. This will NOT override C<$SIG{__WARN__}>, instead
526             it will intercept all output to STDERR when it calls your tracer.
527              
528             =item %tests
529              
530             If you do not specify any tests then all will be run. If you only want to run a
531             subset of tests then you can list them with a true value.
532              
533             test_tracer(
534             name => "foo",
535             type => 'return',
536             trace => \&trace,
537             convert => sub { ... },
538              
539             test_stack_hide => 1,
540             test_stack_shift => 1,
541             test_stack_stop => 1,
542             test_stack_no_start => 1,
543             test_stack_alter => 1,
544             test_stack_shift_and_hide => 1,
545             test_stack_shift_short => 1,
546             test_stack_hide_short => 1,
547             test_stack_shift_and_alter => 1,
548             test_stack_full_combo => 1,
549             );
550              
551             =back
552              
553             =back
554              
555             =head2 OPTIONAL EXPORTS / TESTS
556              
557             =over 4
558              
559             =item test_stack_hide(\&callback)
560              
561             =item test_stack_shift(\&callback)
562              
563             =item test_stack_stop(\&callback)
564              
565             =item test_stack_no_start(\&callback)
566              
567             =item test_stack_alter(\&callback)
568              
569             =item test_stack_shift_and_hide(\&callback)
570              
571             =item test_stack_shift_short(\&callback)
572              
573             =item test_stack_hide_short(\&callback)
574              
575             =item test_stack_shift_and_alter(\&callback)
576              
577             =item test_stack_full_combo(\&callback)
578              
579             =back
580              
581             =head1 SOURCE
582              
583             The source code repository for Trace-Mask can be found at
584             F.
585              
586             =head1 MAINTAINERS
587              
588             =over 4
589              
590             =item Chad Granum Eexodist@cpan.orgE
591              
592             =back
593              
594             =head1 AUTHORS
595              
596             =over 4
597              
598             =item Chad Granum Eexodist@cpan.orgE
599              
600             =back
601              
602             =head1 COPYRIGHT
603              
604             Copyright 2015 Chad Granum Eexodist7@gmail.comE.
605              
606             This program is free software; you can redistribute it and/or
607             modify it under the same terms as Perl itself.
608              
609             See F
610              
611             =cut