Add a checker we can use in other test functions

MANIFEST

@@ -14,3 +14,4 @@ t/sizeof.t
 t/bool.t
 lib/Test2/Tools/Type.pm
 t/test2-tools-type.t
+lib/Test2/Compare/Type.pm

Makefile.PL

@@ -19,10 +19,12 @@ WriteMakefile(
         'Carp'            => 0,
         'if'              => 0,
 
-        'Test::Exception' => 0,        # for Scalar::Type tests, these will eventually get ported to Test2
+        # for Scalar::Type tests, these will eventually get ported to Test2
+        'Test::Exception' => 0,
         'Test::More'      => 0.96,
 
-        'Test2::API'      => 1.302198, # for Test2::Tools::Type, earlier probably works too
+        # for Test2::Tools::Type, earlier probably works too
+        'Test2::API'      => 1.302198,
         'Test2::V0'       => 0.000159,
     },
 );

lib/Test2/Compare/Type.pm

@@ -0,0 +1,99 @@
+package Test2::Compare::Type;
+
+# almost entirely cargo-culted from Test2::Compare::Pattern
+
+use strict;
+use warnings;
+
+use base 'Test2::Compare::Base';
+
+our $VERSION = '1';
+
+use Test2::Util::HashBase qw(type);
+use Test2::Compare::Negatable;
+use Test2::Tools::Type ();
+use Scalar::Type qw(bool_supported);
+
+use Carp qw(croak);
+
+sub init {
+    my $self = shift;
+
+    croak "'type' is a required attribute" unless($self->{+TYPE});
+    croak "'".$self->{+TYPE}."' is not a valid type"
+        unless(Test2::Tools::Type->can('is_'.$self->{+TYPE}));
+
+    $self->SUPER::init();
+}
+
+sub name { shift->{+TYPE} . "" }
+sub operator { join(' ', 'is', (shift->{+NEGATE} ? 'not' : ()), 'of type') }
+
+sub verify {
+    my $self = shift;
+    my %params = @_;
+    my ($got, $exists) = @params{qw/got exists/};
+
+    return 0 unless $exists;
+
+    my $is_func = 'Test2::Tools::Type::is_'.$self->{+TYPE};
+    my $result;
+    {
+        no strict 'refs';
+        local $Test2::Compare::Type::verifying = 1;
+        $result = $is_func->($got);
+    }
+    $result = !$result if($self->{+NEGATE});
+    return $result;
+}
+
+1;
+
+=head1 NAME
+
+Test2::Compare::Type - Use a type to validate values in a deep comparison.
+
+=head1 DESCRIPTION
+
+This allows you to validate a value's type in a deep comparison.
+Sometimes a value just needs to look right, it may not need to be exact. An
+example is that you care that your code always returns an integer, but you
+don't care whether it is 192 or 3.
+
+=head1 CAVEATS
+
+The definitions of Boolean, integer and number are exactly the same as those in
+L<Scalar::Type>, which this is a thin wrapper around.
+
+=head1 SEE ALSO
+
+L<Scalar::Type>
+
+L<Test2::Tools::Type>
+
+L<Test2>
+
+=head1 BUGS
+
+If you find any bugs please report them on Github, preferably with a test case.
+
+=head1 FEEDBACK
+
+I welcome feedback about my code, especially constructive criticism.
+
+=head1 AUTHOR, COPYRIGHT and LICENCE
+
+Mostly cargo-culted from L<Test2::Compare::Pattern>. Differences from that are
+Copyright 2024 David Cantrell E<lt>F<david@cantrell.org.uk>E<gt>
+
+This software is free-as-in-speech software, and may be used,
+distributed, and modified under the terms of either the GNU
+General Public Licence version 2 or the Artistic Licence. It's
+up to you which one you use. The full text of the licences can
+be found in the files GPL2.txt and ARTISTIC.txt, respectively.
+
+=head1 CONSPIRACY
+
+This module is also free-as-in-mason software.
+
+=cut

lib/Test2/Tools/Type.pm

@@ -3,31 +3,57 @@ package Test2::Tools::Type;
 use strict;
 use warnings;
 
-use base 'Exporter';
+use base qw(Exporter);
+use Carp qw(croak);
 
-use Test2::API qw/context/;
+use Test2::API qw(context);
+use Test2::Compare::Type ();
 
 use Scalar::Type qw(bool_supported);
 
-our @EXPORT = qw(is_integer is_number is_bool bool_supported);
+our @EXPORT = qw(is_integer is_number is_bool bool_supported type);
+
+sub import {
+    if($_[1] && $_[1] eq 'show_types') {
+        print "Supported types:\n";
+        print "  ".substr($_, 3)."\n" foreach(grep { /^is_/ } @EXPORT);
+        exit;
+    }
+    goto &Exporter::import;
+}
 
 sub is_integer { _checker(\&Scalar::Type::is_integer, @_); }
 sub is_number  { _checker(\&Scalar::Type::is_number,  @_); }
 
 sub is_bool {
-    die("You need perl 5.38 or higher to use is_bool")
+    croak("You need perl 5.38 or higher to use is_bool")
         unless(bool_supported());
     _checker(\&Scalar::Type::is_bool, @_);
 }
 
 sub _checker {
     my($checker, $candidate, $name) = @_;
 
+    my $result = $checker->($candidate);
+
+    # if we're coming from Test2::Compare::Type just do the check, don't
+    # get/twiddle/release a context
+    return $result if($Test2::Compare::Type::verifying);
+
     my $ctx = context();
-    return $ctx->pass_and_release($name) if($checker->($candidate));
+    return $ctx->pass_and_release($name) if($result);
     return $ctx->fail_and_release($name);
 }
 
+sub type {
+    my @caller = caller;
+    return Test2::Compare::Type->new(
+        file  => $caller[1],
+        lines => [$caller[2]],
+        type  => $_[0],
+    );
+}
+
 1;
 
 =head1 NAME
@@ -48,6 +74,13 @@ Test2::Tools::Type - Tools for checking data types
         is_bool(3.1415, "is pi a Boolean?");      # fail, no it isn't
     }
 
+    like
+        { should_be_int => 1, other_stuff => "we don't care about this" },
+        hash {
+            field should_be_int => type('integer');
+        },
+        "is the should_be_int field an integer?";
+
 =head1 OVERVIEW
 
 Sometimes you don't want to be too precise in your tests, you just want to
@@ -66,13 +99,13 @@ otherwise. It will be true if your perl is version 5.35.7 or higher.
 
 =head2 is_bool
 
+Emits a test pass if its argument is a Boolean - ie is the result of a comparison -
+and a fail otherwise.
+
 It is a fatal error to call this on a perl that is too old. If your tests need
 to run on perl 5.35.6 or earlier then you will need to check C<bool_supported>
 before using it. See the L</SYNOPSIS> above.
 
-Emits a test pass if its argument is a Boolean - ie is the result of a comparison -
-and a fail otherwise.
-
 =head2 is_integer
 
 Emits a test pass if its argument is an integer and a fail otherwise. Note that it
@@ -84,6 +117,27 @@ Emits a test pass if its argument is a number and a fail otherwise. Note that it
 can tell the difference between C<1> (a number), C<1.2> (also a number) and
 C<'1'> (a string).
 
+=head2 type
+
+Returns a check that you can use in a test such as:
+
+    like
+        { int => 1 },
+        hash { field int => type('integer'); },
+        "the 'int' field is an integer";
+
+You can negate the test with a C<!> thus. This test will fail:
+
+    like
+        { int => 1 },
+        hash { field int => !type('integer'); },
+        "the 'int' field is an integer";
+
+Valid arguments are any of the C<is_*> methods' names, with the leading C<is_> removed.
+You can see a list of supported types thus:
+
+    $ perl -MTest2::Tools::Type=show_types -e0
+
 =head1 CAVEATS
 
 The definitions of Boolean, integer and number are exactly the same as those in

t/pod-coverage.t

@@ -4,7 +4,7 @@ use warnings;
 use Test::More;
 eval "use Test::Pod::Coverage 1.08";
 plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@;
-foreach my $module (grep { $_ !~ m{\b(UK::Exchanges|Data|StubCountry(::..)?)$} } all_modules()) {
+foreach my $module (grep { $_ !~ /^Test2::Compare::Type$/ } all_modules()) {
     pod_coverage_ok($module);
 }
 done_testing();