The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# tests for util/smartlinks.pl
# [TODO] add more tests for the remaining subs.

use strict;
use warnings;
use Test::More tests => 17+1;
use Test::NoWarnings;

use FindBin;

use Text::SmartLinks;

my $sl = Text::SmartLinks->new;

# L<Text::SmartLinks/parse_pattern>
# Test sub parse_pattern
{
    my $got = $sl->parse_pattern('/abc .* C<cd>/');
    isnt $got, 'abc .* C<cd>', 'legacy regex pattern no longer works';

    $got = $sl->parse_pattern(q{'abc' '"123"' 567});
    is $got, '\babc\b.+?\"123\".+?\b567\b', 'keyphrase pattern works';

    unlike 'abc d is 5"123"567', qr/$got/, 'the regex works';
    unlike 'abcd is 5"123" 567', qr/$got/, 'the regex works';
    like 'abc d is 5"123" 567', qr/$got/, 'the regex works';

    $got = $sl->parse_pattern(q{he likes me. right?});
    is $got, '\bhe\b.+?\blikes\b.+?\bme\..+?\bright\?', 'chars get quoted';
    like 'i do believe he really likes john and me. am i right? hehe.',
        qr/$got/, 'regex matched';

    $got = $sl->parse_pattern(q{'he likes me. right?'});
    is $got, '\bhe\ likes\ me\.\ right\?',
        'chars get quoted and spaces are reserved';
    ok 'i do believe he really likes john and me. am i right? hehe.' !~
        qr/$got/, 'regex not matched';

    $got = $sl->parse_pattern(q{"he likes me. right?"});
    is $got, '\bhe\ likes\ me\.\ right\?',
        'chars get quoted and spaces are reserved';
    ok 'i do believe he really likes john and me. am i right? hehe.' !~
        qr/$got/, 'regex not matched';
}

# L<Text::SmartLinks/process_paragraph>
# Test sub process_paragraph
{
    my $para = <<_EOC_;
Characters with no corresponding closing character do not qualify
as opening brackets.  This includes the second section of the Unicode
BidiMirroring data table, as well as C<U+201A> and C<U+201E>.
_EOC_
    my $str = $sl->process_paragraph($para);
    is $str,
       'Characters with no corresponding closing character do not qualify '.
       'as opening brackets.  This includes the second section of the Unicode '.
       'BidiMirroring data table, as well as U+201A and U+201E. ',
    'paragraph gets processed.';

    is $sl->process_paragraph('I I<love> B<perl>!'), 'I love perl!',
        'I<...> and B<...> stripped';
    is $sl->process_paragraph('so C<< a < b >> holds'), 'so a < b holds',
        'C<<...>> stripped';
}

# Test subs 
{
    my $para = <<_EOC_;
As a special case to facilitate commenting out sections of code with
C<s/^/#/>, C<#> on the beginning of line is always considered a line-end
comment rather than an embedded comment, even if followed by a bracketing
character.
_EOC_

    my $str = $sl->process_paragraph($para);
    is $str,
        'As a special case to facilitate commenting out sections of code with '.
        's/^/#/, # on the beginning of line is always considered a line-end '.
        'comment rather than an embedded comment, even if followed by a bracketing '.
        'character. ',
    'paragraph processed as expected';

    my $regex = $sl->parse_pattern('"#" on "beginning of line" always "line-end comment"');
    is $regex, '\#.+?\bon\b.+?\bbeginning\ of\ line\b.+?\balways\b.+?\bline\-end\ comment\b',
        'regex generated as expected';
    like $str, qr/$regex/, 'text matched';
}