The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/opt/perl/bin/perl

use strict;
use warnings;
no  warnings 'syntax';

use Regexp::Common;
use Test::More;

my $r = eval "require Test::Regexp; 1";

unless ($r) {
    print "1..0 # SKIP Test::Regexp not found\n";
    exit;
}

unless ($] >= 5.014) {
    print "1..0 # SKIP Pattern not available on this version of Perl\n";
    exit;
}

sub make_test {
    my ($name, $pat) = @_;
    my $keep = $$pat {-keep};
    Test::Regexp::   -> new -> init (
        pattern      => $pat,
        keep_pattern => $keep,
        name         => $name,
    );
}

#
# Pairs of brackets
#
my @pairs = map {[chr $$_ [1], chr ($$_ [2] // ($$_ [1] + 1)), $$_ [0]]} 
   ["parenthesis"                                             =>  0x0028,
                                                                  0x0029],
   ["square bracket"                                          =>  0x005B,
                                                                  0x005D],
   ["curly brackets"                                          =>  0x007B,
                                                                  0x007D],
   ["double quotation marks"                                  =>  0x201C],
   ["quotation marks"                                         =>  0x2018],
   ["single pointing angle quotation marks"                   =>  0x2039],
   ["pointing double angle quotation marks"                   =>  0x00AB,
                                                                  0x00BB],
   ["fullwidth parenthesis"                                   =>  0xFF08],
   ["fullwidth square brackets"                               =>  0xFF3B,
                                                                  0xFF3D],
   ["fullwidth curly brackets"                                =>  0xFF5B,
                                                                  0xFF5D],
   ["fullwidth white parenthesis"                             =>  0xFF5F],
   ["white parenthesis"                                       =>  0x2985],
   ["white square brackets"                                   =>  0x301A],
   ["white curly brackets"                                    =>  0x2983],
   ["corner brackets"                                         =>  0x300C],
   ["angle brackets"                                          =>  0x3008],
   ["double angle brackets"                                   =>  0x300A],
   ["black lenticular brackets"                               =>  0x3010],
   ["tortoise shell brackets"                                 =>  0x3014],
   ["black tortoise shell brackets"                           =>  0x2997],
   ["white corner brackets"                                   =>  0x300E],
   ["white lenticular brackets",                              =>  0x3016],
   ["white tortoise shell brackets"                           =>  0x3018],
   ["halfwidth corner brackets"                               =>  0xFF62],
   ["mathematical white square brackets"                      =>  0x27E6],
   ["mathematical angle brackets"                             =>  0x27E8],
   ["mathematical double angle brackets"                      =>  0x27EA],
   ["mathematical flattened parenthesis"                      =>  0x27EE],
   ["mathematical white tortoise shell brackets"              =>  0x27EC],
   ["ceiling"                                                 =>  0x2308],
   ["floor"                                                   =>  0x230A],
   ["Z notation image brackets"                               =>  0x2987],
   ["Z notation binding brackets"                             =>  0x2989],
   ["heavy single commas"                                     =>  0x275B],
   ["heavy double commas"                                     =>  0x275D],
   ["medium parenthesis ornaments"                            =>  0x2768],
   ["medium flattened parenthesis ornaments"                  =>  0x276A],
   ["medium curly bracket ornaments"                          =>  0x2774],
   ["medium pointing angle bracket ornaments"                 =>  0x276C],
   ["heavy pointing angle quotation mark ornaments"           =>  0x276E],
   ["heavy pointing angle bracket ornaments"                  =>  0x2770],
   ["light tortoise shell bracket ornaments"                  =>  0x2772],
   ["ornate parenthesis"                                      =>  0xFD3E],
   ["top-bottom parenthesis"                                  =>  0x23DC],
   ["top-bottom square brackets"                              =>  0x23B4],
   ["top-bottom curly brackets"                               =>  0x23DE],
   ["top-bottom tortoise shell brackets"                      =>  0x23E0],
   ["presentation form for vertical corner brackets"          =>  0xFE41],
   ["presentation form for vertical white corner brackets"    =>  0xFE43],
   ["presentation form for vertical tortoise shell brackets"  =>  0xFE39],
   ["presentation form for vertical black lenticul brackets"  =>  0xFE3B],
   ["presentation form for vertical white lenticul brackets"  =>  0xFE17],
   ["presentation form for vertical angle brackets"           =>  0xFE3F],
   ["presentation form for vertical double angle brackets"    =>  0xFE3D],
   ["presentation form for vertical square brackets"          =>  0xFE47],
   ["presentation form for vertical curly brackets"           =>  0xFE37],
   ["pointing angle brackets"                                 =>  0x2329],
   ["angle brackets with dots"                                =>  0x2991],
   ["pointing curved angle brackets"                          =>  0x29FC],
   ["small parenthesis"                                       =>  0xFE59],
   ["small curly brackets"                                    =>  0xFE5B],
   ["small tortoise shell brackets"                           =>  0xFE5D],
   ["superscript parenthesis"                                 =>  0x207D],
   ["subscript parenthesis"                                   =>  0x208D],
   ["square brackets with underbars"                          =>  0x298B],
   ["square brackets with top-bottom ticks"                   =>  0x298D],
   ["square brackets with bottom-top ticks"                   =>  0x298F],
   ["square brackets with quills"                             =>  0x2045],
   ["top half brackets"                                       =>  0x2E22],
   ["bottom half brackets"                                    =>  0x2E24],
   ["S-shaped bag delimiters"                                 =>  0x27C5],
   ["arcs with less/greater than brackets"                    =>  0x2993],
   ["double arcs with greater/less than brackets"             =>  0x2995],
   ["sideways U brackets"                                     =>  0x2E26],
   ["double parenthesis"                                      =>  0x2E28],
   ["wiggly fences"                                           =>  0x29D8],
   ["double wiggly fences"                                    =>  0x29DA],
   ["low paraphrase brackets"                                 =>  0x2E1C],
   ["raised omission brackets"                                =>  0x2E0C],
   ["substitution brackets"                                   =>  0x2E02],
   ["double substitution brackets"                            =>  0x2E04],
   ["transposition brackets"                                  =>  0x2E09],
   ["Ogham feather marks"                                     =>  0x169B],
   ["Tibetan marks gug rtags"                                 =>  0x0F3A],
   ["Tibetan marks ang khang"                                 =>  0x0F3C],
;

#
# Test double quoted delimiter
#
{
    my $test = make_test "Bracketed string" =>
                         $RE {bquoted};

    foreach my $pair (@pairs) {
        my ($left, $right, $name) = @$pair;

        $test -> match ("${left}A few words${right}",
                       ["${left}A few words${right}", $left,
                               "A few words",         $right],
                       test => "Using ${name} as delimiters");

        $test -> match ("${left}A few ${left}words${right}",
                       ["${left}A few ${left}words${right}", $left,
                               "A few ${left}words",         $right],
                       test => "Using ${name} as delimiters; " .
                               "use opening delimiter in string");

        $test -> match ("${left}A few \\${right}words${right}",
                       ["${left}A few \\${right}words${right}", $left,
                               "A few \\${right}words",         $right],
                       test => "Using ${name} as delimiters; " .
                               "use escaped closing delimiter in string");

        $test -> match ("${left}A few\nwords${right}",
                       ["${left}A few\nwords${right}", $left,
                               "A few\nwords",         $right],
                       test => "Using ${name} as delimiters; " .
                               "don't trip over newlines");

        $test -> no_match ("${left}A few words${left}",
                            reason => "Using opening delimiter " .
                                      "as the closing one");

        $test -> no_match ("${right}A few words${right}",
                            reason => "Using closing delimiter " .
                                      "as the opening one");

        $test -> no_match ("${left}A few ${right}words${right}",
                            reason => "Unescaped closing delimiter in string");

        $test -> no_match ("${left}A few words\\${right}",
                            reason => "Escaping the closing delimiter is bad");

        $test -> no_match ("${left}A few \\\\${right}words${right}",
                            reason => "Unescaped the escape neutralizes");
    }

    foreach (my $i = 0; $i < @pairs; $i ++) {
        my $j  = ($i + 7) ** 2;
           $j %= @pairs;
        if ($j == $i) {
            $j += 15;
            $j %= @pairs;
        }
        my $left  = $pairs [$i] [0];
        my $right = $pairs [$j] [1];

        $test -> no_match ("${left}A few words${right}",
                            reason => "Mismatched delimiters");
    }
}



done_testing;