diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm b/Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm new file mode 100755 index 00000000000..9d71982af29 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm @@ -0,0 +1,78 @@ +use strict; +use warnings; + +package Test::Deep::Methods; + +use Test::Deep::Cmp; + +sub init +{ + my $self = shift; + + # get them all into [$name,@args] => $value format + my @methods; + while (@_) + { + my $name = shift; + my $value = shift; + push(@methods, + [ + ref($name) ? $name : [ $name ], + $value + ] + ); + } + $self->{methods} = \@methods; +} + +sub descend +{ + my $self = shift; + my $got = shift; + + my $data = $self->data; + + foreach my $method (@{$self->{methods}}) + { + $data->{method} = $method; + + my ($call, $exp_res) = @$method; + my ($name) = @$call; + + my $got_res = UNIVERSAL::can($got, $name) ? + $self->call_method($got, $call) : + $Test::Deep::DNE; + + next if Test::Deep::descend($got_res, $exp_res); + + return 0; + } + + return 1; +} + +sub call_method +{ + my $self = shift; + my ($got, $call) = @_; + my ($name, @args) = @$call; + + return $got->$name(@args); +} + +sub render_stack +{ + my $self = shift; + my ($var, $data) = @_; + + my $method = $data->{method}; + my ($call, $expect) = @$method; + my ($name, @args) = @$call; + + my $args = @args ? "(".join(", ", @args).")" : ""; + $var .= "->$name$args"; + + return $var; +} + +1; |