1use strict; 2use warnings; 3 4package Test::Deep::Methods; 5 6use Test::Deep::Cmp; 7 8sub init 9{ 10 my $self = shift; 11 12 # get them all into [$name,@args] => $value format 13 my @methods; 14 while (@_) 15 { 16 my $name = shift; 17 my $value = shift; 18 push(@methods, 19 [ 20 ref($name) ? $name : [ $name ], 21 $value 22 ] 23 ); 24 } 25 $self->{methods} = \@methods; 26} 27 28sub descend 29{ 30 my $self = shift; 31 my $got = shift; 32 33 my $data = $self->data; 34 35 foreach my $method (@{$self->{methods}}) 36 { 37 $data->{method} = $method; 38 39 my ($call, $exp_res) = @$method; 40 my ($name) = @$call; 41 42 my $got_res = UNIVERSAL::can($got, $name) ? 43 $self->call_method($got, $call) : 44 $Test::Deep::DNE; 45 46 next if Test::Deep::descend($got_res, $exp_res); 47 48 return 0; 49 } 50 51 return 1; 52} 53 54sub call_method 55{ 56 my $self = shift; 57 my ($got, $call) = @_; 58 my ($name, @args) = @$call; 59 60 return $got->$name(@args); 61} 62 63sub render_stack 64{ 65 my $self = shift; 66 my ($var, $data) = @_; 67 68 my $method = $data->{method}; 69 my ($call, $expect) = @$method; 70 my ($name, @args) = @$call; 71 72 my $args = @args ? "(".join(", ", @args).")" : ""; 73 $var .= "->$name$args"; 74 75 return $var; 76} 77 781; 79