path: root/t/rjbs.t

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

use smartmatch 'rjbs';

{
    package SmartOverload;
    use overload '~~' => sub {
        no warnings 'uninitialized';
        return $_[1] eq ${ $_[0] };
    }, fallback => 1;
}

{
    package RegexOverload;
    use overload 'qr' => sub {
        return $_[0]->[0];
    }, fallback => 1;
}

{
    package StringOverload;
    use overload '""' => sub {
        return $_[0]->{val};
    }, fallback => 1;
}

sub smart  { my $val = shift; bless \$val,           SmartOverload::  }
sub regex  { my $val = shift; bless [qr/$val/],      RegexOverload::  }
sub string { my $val = shift; bless { val => $val }, StringOverload:: }

my @tests = (
    # undef
    [ 1,     undef,        undef ],
    [ 0,     '',           undef ],
    [ 0,     0,            undef ],
    [ 0,     '0',          undef ],
    [ 0,     '0.0',        undef ],
    [ 0,     '0 but true', undef ],
    [ 0,     1,            undef ],
    [ 0,     'x',          undef ],
    [ 0,     [],           undef ],
    [ 0,     {},           undef ],
    [ 0,     sub {},       undef ],
    [ 0,     smart(''),    undef ],
    [ 0,     regex(''),    undef ],
    [ 0,     string(''),   undef ],
    # smart match overload
    [ 1,     "smart",         smart('smart') ],
    [ 1,     string('smart'), smart('smart') ],
    [ 0,     "SMART",         smart('smart') ],
    [ 0,     string('SMART'), smart('smart') ],
    [ 0,     smart('smart'),  smart('smart') ],
    [ 0,     undef,           smart('smart') ],
    [ 0,     1,               smart('smart') ],
    # regex
    [ 0,     undef,         qr/a/             ],
    [ 1,     undef,         qr/a?/            ],
    [ 1,     "foo",         qr/f/             ],
    [ 0,     "foo",         qr/g/             ],
    [ 1,     1,             qr/1/             ],
    [ 0,     ['z'],         qr/z/             ],
    [ 1,     ['z'],         qr/^ARRAY/        ],
    [ 0,     {'y' => 'y'},  qr/y/             ],
    [ 1,     {'y' => 'y'},  qr/^HASH/         ],
    [ 1,     string('foo'), qr/^foo$/         ],
    [ 0,     regex('foo'),  qr/foo/           ],
    [ 1,     regex('foo'),  qr/^Regex/        ],
    [ 1,     qr/foo/,       qr/\(\?\^\:foo\)/ ],
    # regex overload
    [ 0,     undef,         regex('a')             ],
    [ 1,     undef,         regex('a?')            ],
    [ 1,     "foo",         regex('f')             ],
    [ 0,     "foo",         regex('g')             ],
    [ 1,     1,             regex('1')             ],
    [ 0,     ['z'],         regex('z')             ],
    [ 1,     ['z'],         regex('^ARRAY')        ],
    [ 0,     {'y' => 'y'},  regex('y')             ],
    [ 1,     {'y' => 'y'},  regex('^HASH')         ],
    [ 1,     string('foo'), regex('^foo$')         ],
    [ 0,     regex('foo'),  regex('foo')           ],
    [ 1,     regex('foo'),  regex('^Regex')        ],
    [ 1,     qr/foo/,       regex('\(\?\^\:foo\)') ],
    # code
    [ 1,     undef,        sub { 1 }                    ],
    [ 1,     '',           sub { 1 }                    ],
    [ 1,     0,            sub { 1 }                    ],
    [ 1,     '0',          sub { 1 }                    ],
    [ 1,     '0.0',        sub { 1 }                    ],
    [ 1,     '0 but true', sub { 1 }                    ],
    [ 1,     1,            sub { 1 }                    ],
    [ 1,     'x',          sub { 1 }                    ],
    [ 1,     [],           sub { 1 }                    ],
    [ 1,     {},           sub { 1 }                    ],
    [ 1,     sub {},       sub { 1 }                    ],
    [ 1,     smart(''),    sub { 1 }                    ],
    [ 1,     regex(''),    sub { 1 }                    ],
    [ 1,     string(''),   sub { 1 }                    ],
    [ 0,     undef,        sub { 0 }                    ],
    [ 0,     '',           sub { 0 }                    ],
    [ 0,     0,            sub { 0 }                    ],
    [ 0,     '0',          sub { 0 }                    ],
    [ 0,     '0.0',        sub { 0 }                    ],
    [ 0,     '0 but true', sub { 0 }                    ],
    [ 0,     1,            sub { 0 }                    ],
    [ 0,     'x',          sub { 0 }                    ],
    [ 0,     [],           sub { 0 }                    ],
    [ 0,     {},           sub { 0 }                    ],
    [ 0,     sub {},       sub { 0 }                    ],
    [ 0,     smart(''),    sub { 0 }                    ],
    [ 0,     regex(''),    sub { 0 }                    ],
    [ 0,     string(''),   sub { 0 }                    ],
    [ 1,     ['a', 'b'],   sub { ref $_[0] eq 'ARRAY' } ],
    [ 1,     ['a', 'b'],   sub { $_[0]->[0] eq 'a' }    ],
    [ 1,     string('x'),  sub { $_[0] eq 'x' }         ],
    [ 1,     smart('x'),   sub { 'x' ~~ $_[0] }         ],
    [ 0,     smart('x'),   sub { 'y' ~~ $_[0] }         ],
    # any
    [ 'die', undef, ''           ],
    [ 'die', undef, 0            ],
    [ 'die', undef, '0'          ],
    [ 'die', undef, '0.0'        ],
    [ 'die', undef, '0 but true' ],
    [ 'die', undef, 1            ],
    [ 'die', undef, 'x'          ],
    [ 'die', undef, []           ],
    [ 'die', undef, {}           ],
    [ 0,     undef, sub {}       ],
    [ 1,     undef, smart('')    ],
    [ 1,     undef, regex('')    ],
    [ 'die', undef, string('')   ],
);

for my $test (@tests) {
    # shut up warnings about undef =~ regex
    $SIG{__WARN__} = sub { } unless defined $test->[1];

    if ($test->[0] eq 'die') {
        ok(!eval { $test->[1] ~~ $test->[2]; 1 });
        like($@, qr/invalid smart match/);
    }
    elsif ($test->[0]) {
        ok($test->[1] ~~ $test->[2]);
    }
    else {
        ok(!($test->[1] ~~ $test->[2]));
    }

    delete $SIG{__WARN__};
}

done_testing;