summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm')
-rwxr-xr-xMaster/tlpkg/tlperl.straw/lib/Test/Deep/Methods.pm78
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;