Add is_{positive,negative}_{number,integer} functions

lib/Test2/Tools/Type.pm

@@ -34,6 +34,28 @@ sub is_bool {
     _checker(\&Scalar::Type::is_bool, @_);
 }
 
+my %direction_checks = (
+    'positive' => sub { $_[0] > 0 },
+    'negative' => sub { $_[0] < 0 },
+);
+
+foreach my $type (qw(integer number)) {
+    foreach my $direction (qw(positive negative)) {
+        my $is_function = join('_', 'is', $direction, $type);
+        push @EXPORT, $is_function;
+        no strict 'refs';
+        *{$is_function} = sub {
+            _checker(
+                _all_of(
+                    "Scalar::Type::is_$type",
+                    $direction_checks{$direction},
+                ),
+                @_
+            )
+        };
+    }
+}
+
 sub _checker {
     my($checker, $candidate, $name) = @_;
 
@@ -48,6 +70,18 @@ sub _checker {
     return $ctx->fail_and_release($name);
 }
 
+sub _all_of {
+    my($head, @tail) = @_;
+    sub {
+        no strict 'refs';
+        my $result = $head->($_[0]);
+        if(@tail) {
+            $result &&= _all_of(@tail)->($_[0]);
+        }
+        $result;
+    }
+}
+
 sub type {
     my @caller = caller;
     return Test2::Compare::Type->new(
@@ -120,6 +154,10 @@ 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 is_positive_number, is_negative_number, is_positive_integer, is_negative_integer
+
+Like the above but also check the argument's sign.
+
 =head2 type
 
 Returns a check that you can use in a test such as:

t/test2-tools-type.t

@@ -15,6 +15,19 @@ subtest "is_* tests" => sub {
         is_number(1.2, "pass");
         is_number("1", "fail");
 
+        is_positive_number("1.2", "fail");
+        is_positive_number(1.2,   "pass");
+        is_positive_number(-1.2,  "fail");
+        is_negative_number(-1.2,  "pass");
+        is_negative_number(1.2,   "fail");
+
+        is_positive_integer("1", "fail");
+        is_positive_integer(1.2, "fail");
+        is_positive_integer(1,   "pass");
+        is_positive_integer(-1,  "fail");
+        is_negative_integer(-1,  "pass");
+        is_negative_integer(1,   "fail");
+
         if(bool_supported()) {
             is_bool(1==1, "pass");
             is_bool(1==2, "pass");
@@ -33,9 +46,24 @@ subtest "is_* tests" => sub {
         { result => 'Pass', name => 'is_integer(1)'   },
         { result => 'Fail', name => 'is_integer(1.2)' },
         { result => 'Fail', name => 'is_integer("1")' },
+
         { result => 'Pass', name => 'is_number(1)'    },
         { result => 'Pass', name => 'is_number(1.2)'  },
         { result => 'Fail', name => 'is_number("1")'  },
+
+        { result => 'Fail', name => 'is_positive_number("1.2")' },
+        { result => 'Pass', name => 'is_positive_number(1.2)'   },
+        { result => 'Fail', name => 'is_positive_number(-1.2)'  },
+        { result => 'Pass', name => 'is_negative_number(-1.2)'  },
+        { result => 'Fail', name => 'is_negative_number(1.2)'   },
+
+        { result => 'Fail', name => 'is_positive_integer("1")' },
+        { result => 'Fail', name => 'is_positive_integer(1.2)' },
+        { result => 'Pass', name => 'is_positive_integer(1)'   },
+        { result => 'Fail', name => 'is_positive_integer(-1)'  },
+        { result => 'Pass', name => 'is_negative_integer(-1)'  },
+        { result => 'Fail', name => 'is_negative_integer(1)'   },
+
         { result => 'Pass', name => 'is_bool(1==1)',    bool_required => 1 },
         { result => 'Pass', name => 'is_bool(1==2)',    bool_required => 1 },
         { result => 'Fail', name => 'is_bool(1)',       bool_required => 1 },
@@ -70,7 +98,14 @@ subtest "type() tests" => sub {
         is(1.2, type('integer'));  # fail
         is(1,   !type('integer')); # fail
         is(1.2, !type('integer')); # pass
+
         is(1.2, type('number'));   # pass
+
+        is('1.2', !type('positive_number')); # pass
+        is('1.2', type('positive_number')); # fail
+        is(1.2,   type('positive_number')); # pass
+        is(-1.2,  type('positive_number')); # fail
+
         if(bool_supported()) {
             is(1==1, type('bool')); # pass
             is(1==2, type('bool')); # pass
@@ -93,7 +128,14 @@ subtest "type() tests" => sub {
         { result => "Fail", name => "is(1.2,  type('integer'))"  },
         { result => "Fail", name => "is(1,    !type('integer'))" },
         { result => "Ok",   name => "is(1.2,  !type('integer'))" },
+
         { result => "Ok",   name => "is(1.2,  type('number'))"   },
+
+        { result => "Ok",   name => "is('1.2', !type('positive_number'))"  },
+        { result => "Fail", name => "is('1.2', type('positive_number'))"   },
+        { result => "Ok",   name => "is(1.2,   type('positive_number'))"   },
+        { result => "Fail", name => "is(-1.2,  type('positive_number'))"   },
+
         { result => "Ok",   name => "is(1==1, type('bool'))", bool_required => 1 },
         { result => "Ok",   name => "is(1==2, type('bool'))", bool_required => 1 },
         { result => "Fail", name => "is(1.2,  type('bool'))", bool_required => 1 },
@@ -123,13 +165,18 @@ subtest "type() tests" => sub {
 };
 
 subtest "show supported types" => sub {
+    my $types_supported = capture { system(
+        $Config{perlpath}, (map { "-I$_" } (@INC)),
+        qw(-MTest2::Tools::Type=show_types -e0)
+    ) };
+    like
+        $types_supported,
+        qr/\n  negative_number\n/,
+        "found 'negative_number'";
     like
-        capture { system(
-            $Config{perlpath}, (map { "-I$_" } (@INC)),
-            qw(-MTest2::Tools::Type=show_types -e0)
-        ) },
+        $types_supported,
         qr/\n  bool\n/,
-        "groovy";
+        "found 'bool'";
 };
 
 done_testing;