view release on metacpan or  search on metacpan

t/23-special.t  view on Meta::CPAN

package Test::DX;

use Devel::DumpTrace ':test';
use PadWalker;
use Test::More tests => 17;
use strict;
use warnings;
use vars qw($g @g %g $G);

# exercise  Devel::DumpTrace::perform_variable_substitutions
# on some edge cases

$Devel::DumpTrace::DB_ARGS_DEPTH = 2;

# insert one extra stack frame so that perform_variable_substitutions
# can get the right '@_'

my $S = $Devel::DumpTrace::XEVAL_SEPARATOR;

sub substitute_args {
  my @args = @_;
  save_pads();
  my $subst1 = substitute('@_', __PACKAGE__);
  my $subst2 = substitute('@args', __PACKAGE__);
  shift @_;
  pop @_;
  my @z = @_;
  save_pads();
  my $subst3 = substitute('@_', __PACKAGE__);
  my $subst4 = substitute('@z', __PACKAGE__);
  ($subst1, $subst2, $subst3, $subst4);
}

my $foo = 'shoe';
my ($s1, $s2, $s3, $s4) = substitute_args(1,2,'buckle',$foo);
ok($s1 eq "(1,2,'buckle','shoe')", 'substitute for @_') or diag($s1);
ok($s2 eq "(1,2,'buckle','shoe')", 'substitute for my @_ copy') or diag($s2);
ok($s4 eq "(2,'buckle')", 'substitute for copy of  modified @_') or diag($s4);

# Why doesn't this test pass?
#    I expect $s3 to contain the current contents of @_ ((2,'buckle'))
#    or even the original contents ((1,2,'buckle','shoe')) but it 
#    actually is "(1,2,'buckle')"
#
#    aha, a revelation from  perldoc -f caller (>= 5.12)
#        Also be aware that setting @DB::args is best effort, intended for 
#        debugging or generating backtraces, and should not be relied upon. 
#        In particular, as @_ contains aliases to the caller's arguments, 
#        Perl does not take a copy of @_ , so @DB::args will contain 
#        modifications the subroutine makes to @_ or its contents, not the 
#        original values at call time. @DB::args , like @_ , does not hold 
#        explicit references to its elements, so under certain cases its 
#        elements may have become freed and reallocated for other variables 
#        or temporary values. Finally, a side effect of the current 
#        implementation means that the effects of shift @_ can normally be 
#        undone (but not pop @_ or other splicing, and not if a reference 
#        to @_ has been taken, and subject to the caveat about reallocated 
#        elements), so @DB::args is actually a hybrid of the current state 
#        and initial state of @_ . Buyer beware.
#
ok(1, "# substitute for modified \@_") or
  ok($s3 eq "(2,'buckle')", 'substitute for modified @_') or diag($s3);

sub substitution_arg_s {