From ee78864acd6f671374752837ec965cd81a5f89cb Mon Sep 17 00:00:00 2001 From: David Cantrell Date: Tue, 16 Apr 2024 22:02:52 +0100 Subject: [PATCH] Add is_{positive,negative}_{number,integer} functions --- lib/Test2/Tools/Type.pm | 38 +++++++++++++++++++++++++++ t/test2-tools-type.t | 57 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 90 insertions(+), 5 deletions(-) diff --git a/lib/Test2/Tools/Type.pm b/lib/Test2/Tools/Type.pm index e434f27..081858b 100644 --- a/lib/Test2/Tools/Type.pm +++ b/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: diff --git a/t/test2-tools-type.t b/t/test2-tools-type.t index 6de1291..8c1c191 100644 --- a/t/test2-tools-type.t +++ b/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;