The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More 'no_plan';
use Regexp::MatchContext -subs;

my $str = 'foobarbaz';

$str =~ m/ bar (?p)/x;

is PREMATCH,  'foo'     =>    'PREMATCH set correctly';
is MATCH,     'bar'     =>    'MATCH set correctly';
is POSTMATCH, 'baz'     =>    'POSTMATCH set correctly';

$str =~ m/ bar /x;

ok !defined PREMATCH,  =>    'PREMATCH unset correctly';
ok !defined MATCH,     =>    'MATCH unset correctly';
ok !defined POSTMATCH, =>    'POSTMATCH unset correctly';

$str =~ m/ baz (?p)/x;

is PREMATCH,  'foobar'  =>    'PREMATCH set correctly again';
is MATCH,     'baz'     =>    'MATCH set correctly again';
is POSTMATCH, ''        =>    'POSTMATCH set correctly again';

$str =~ m/ qux (?p)/x;

is PREMATCH,  'foobar'  =>    'PREMATCH left correctly on fail';
is MATCH,     'baz'     =>    'MATCH left correctly on fail';
is POSTMATCH, ''        =>    'POSTMATCH left correctly on fail';

$str =~ m/ foo (?p)/x;

is PREMATCH,  ''        =>    'PREMATCH set correctly yet again';
is MATCH,     'foo'     =>    'MATCH set correctly yet again';
is POSTMATCH, 'barbaz'  =>    'POSTMATCH set correctly yet again';

$str =~ m/ foobarbaz (?p)/x;

is PREMATCH,  ''           =>    'PREMATCH set correctly once again';
is MATCH,     'foobarbaz'  =>    'MATCH set correctly once again';
is POSTMATCH, ''           =>    'POSTMATCH set correctly once again';

$str =~ m/ bar /x;

ok !defined PREMATCH,  =>    'PREMATCH unset correctly again';
ok !defined MATCH,     =>    'MATCH unset correctly again';
ok !defined POSTMATCH, =>    'POSTMATCH unset correctly again';


$str =~ m/ bar (?p)/x;

PREMATCH = '111';
is $str, '111barbaz'        => 'PREMATCH assignment worked';

MATCH = '222';
is $str, '111222baz'        => 'MATCH assignment worked';

POSTMATCH = '333';
is $str, '111222333'        => 'POSTMATCH assignment worked';


$str = 'foobarbaz';
$str =~ m/ bar (?p)/x;

POSTMATCH = '33';
is $str, 'foobar33'        => 'POSTMATCH assignment worked again';

PREMATCH = '1111';
is $str, '1111bar33'       => 'PREMATCH assignment worked again';

MATCH = '222';
is $str, '111122233'       => 'MATCH assignment worked again';

$str = 'foobarbaz';
$str =~ m/ bar /x;

ok !defined eval{ PREMATCH = '1'; 1 }  => 'Bad PREMATCH assignment failed';
is substr($@,0,47), q{Can't assign to $PREMATCH because the preceding}
                                        => 'Correct PREMATCH error';

ok !defined eval{ MATCH = '1'; 1 }  => 'Bad MATCH assignment failed';
is substr($@,0,44), q{Can't assign to $MATCH because the preceding}
                                        => 'Correct MATCH error';

ok !defined eval{ POSTMATCH = '1'; 1 }  => 'Bad POSTMATCH assignment failed';
is substr($@,0,48), q{Can't assign to $POSTMATCH because the preceding}
                                        => 'Correct POSTMATCH error';