aboutsummaryrefslogtreecommitdiff
path: root/t/lib/Test2/Tools
diff options
context:
space:
mode:
Diffstat (limited to 't/lib/Test2/Tools')
-rw-r--r--t/lib/Test2/Tools/MoreCompare.pm55
1 files changed, 55 insertions, 0 deletions
diff --git a/t/lib/Test2/Tools/MoreCompare.pm b/t/lib/Test2/Tools/MoreCompare.pm
new file mode 100644
index 0000000..7ff16ab
--- /dev/null
+++ b/t/lib/Test2/Tools/MoreCompare.pm
@@ -0,0 +1,55 @@
+package Test2::Tools::MoreCompare;
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use Scalar::Util qw/reftype/;
+
+use Test2::API qw/context/;
+use Test2::Util::Ref qw/rtype/;
+
+use Test2::Compare qw{
+ compare
+ get_build push_build pop_build build
+ strict_convert relaxed_convert
+};
+
+use Test2::Compare::Bag();
+
+%Carp::Internal = (
+ %Carp::Internal,
+ 'Test2::Tools::MoreCompare' => 1,
+ 'Test2::Compare::Bag' => 1,
+);
+
+our @EXPORT_OK = qw{
+ bag call_list
+};
+use base 'Exporter';
+
+sub bag(&) { build('Test2::Compare::Bag', @_) }
+
+sub call_list($$) {
+ my ($name, $expect) = @_;
+ my $build = get_build() or croak "No current build!";
+
+ croak "'$build' does not support method calls"
+ unless $build->can('add_call');
+
+ croak "'call_list' should only ever be called in void context"
+ if defined wantarray;
+
+ my @caller = caller;
+ $build->add_call(
+ sub { [ shift->$name ] },
+ Test2::Compare::Wildcard->new(
+ expect => $expect,
+ file => $caller[1],
+ lines => [$caller[2]],
+ ),
+ $name,
+ );
+
+}
+
+1;