The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::DX;

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

# exercise  Devel::DumpTrace::perform_variable_substitutions  on objects

my ($m,@m,%m,$M);
our ($o,@o,%o,$O);

$Devel::DumpTrace::XEVAL_SEPARATOR = ':';
my $S = $Devel::DumpTrace::XEVAL_SEPARATOR;
my $T = $Devel::DumpTrace::HASH_PAIR_SEPARATOR;

{
  package Array::Object;
  sub new {
    my ($pkg, @list) = @_;
    return bless [ @list ], $pkg;
  }
  sub method {
    my $self = shift @_;
    return join ':', @$self;
  }
};

{
  package Hash::Object;
  sub new {
    my ($pkg, $value) = @_;
    bless { attr => $value }, $pkg;
  }
  sub method {
    my $self = shift @_;
    return $self->{attr};
  }
};

save_pads();

$g = $o = new Array::Object(1,2,3,'foo');
$m = new Array::Object(1,2,3,'foo');
$G = $M = $O = new Hash::Object('blah');

foreach my $var (qw($g $m $o)) {
  my $subst = substitute($var, __PACKAGE__);
  ok($subst eq "[Array::Object: 1,2,3,'foo']", "subst $var") or diag $subst;

  my $xsubst = xsubstitute($var, __PACKAGE__);
  ok($xsubst eq $var . $S . $subst, qq'xsubst $var');
}

foreach my $var (qw($G $M $O)) {
  my $subst = substitute($var, __PACKAGE__);
  ok($subst eq "{Hash::Object: 'attr'${T}'blah'}",
     "subst $var") or diag $subst;

  my $xsubst = xsubstitute($var, __PACKAGE__);
  ok($xsubst eq $var . $S . $subst, qq'xsubst $var');
}

my $i = 3;
save_pads();
foreach my $var (qw($g->[$i] $m->[$i] $o->[$i])) {
  my $subst = substitute($var, __PACKAGE__);
  ok($subst eq "[Array::Object: 1,2,3,'foo']->[3]", "subst $var");

  my $xsubst = xsubstitute($var, __PACKAGE__);
  my $xpect = substr($var,0,2) . $S
    . "[Array::Object: 1,2,3,'foo']->[\$i${S}3]";
  ok($xsubst eq $xpect, "xsubst $var") or diag "$xsubst ne $xpect";
}

foreach my $var (qw($g->method(42) $m->method(42) $o->method(42))) {
  my $subst = substitute($var, __PACKAGE__);
  ok($subst eq "[Array::Object: 1,2,3,'foo']->method(42)", "subst $var");

  my $xsubst = xsubstitute($var, __PACKAGE__);
  ok($xsubst eq substr($var,0,2) . $S . $subst, "xsubst $var");
}

$i = 'attr';
foreach my $var (qw($G->{$i} $M->{$i} $O->{$i})) {
  my $subst = substitute($var, __PACKAGE__);
  ok($subst eq "{Hash::Object: 'attr'${T}'blah'}->{'attr'}", "subst $var");

  my $xsubst = xsubstitute($var, __PACKAGE__);

  # $i also gets substituted.
  my $xpect = substr($var,0,2) . $S
    . "{Hash::Object: 'attr'${T}'blah'}->{\$i${S}'attr'}";
  ok($xsubst eq $xpect, "xsubst $var") or diag $xsubst . " ne " . $xpect;
}

foreach my $var (qw($G->method $M->method $O->method)) {
  my $subst = substitute($var, __PACKAGE__);
  ok($subst eq "{Hash::Object: 'attr'${T}'blah'}->method", "subst $var")
    or diag $subst;

  my $xsubst = xsubstitute($var, __PACKAGE__);
  ok($xsubst eq substr($var,0,2) . $S . $subst, "xsubst $var");
}