1use strict; 2use warnings; 3use Test::More tests => 12; 4use Context::Preserve; 5use Test::Exception; 6my $after = 0; 7 8is $after, 0; 9is_deeply [foo()], [qw/an array/]; 10is $after, 1; 11$after = 0; 12is scalar foo(), 'scalar'; 13is $after, 1; 14 15is_deeply [bar()], [qw/an42 array42/]; 16is scalar bar(), 'scalar42'; 17 18is_deeply [baz()], [qw/anARRAY arrayARRAY/]; 19is scalar baz(), 'scalarSCALAR'; 20 21is_deeply [quux()], [qw/hello there friendly world/]; 22is scalar quux(), 'world'; 23 24throws_ok { preserve_context {}, made_up => sub {} } 25 qr/need an "after" or "replace" coderef/; 26 27sub code { 28 if(wantarray){ 29 return qw/an array/ 30 } 31 else { 32 return 'scalar' 33 } 34}; 35 36sub foo { 37 return preserve_context { 38 return code(); 39 } after => sub { $after = 1 }; 40} 41 42sub bar { 43 return preserve_context { 44 return code(); 45 } after => sub { $_ .= "42" for @_ }; 46} 47 48sub baz { 49 return preserve_context { 50 return code(); 51 } after => sub { 52 my $wa = wantarray ? "ARRAY" : "SCALAR"; 53 $_ .= "$wa" for @_ ; 54 return qw/oh noes/; # this is ignored 55 }; 56} 57 58# this was a good idea when i had one function, now it's getting old 59sub quux { 60 return preserve_context { 61 return code(); 62 } replace => sub { 63 return qw/hello there friendly world/; 64 }; 65} 66