The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use English qw( -no_match_vars );

use lib 'lib';

our $THIS_TEST_HAS_TESTS  = 9;
our $THIS_BLOCK_HAS_TESTS = 0;

plan( tests => $THIS_TEST_HAS_TESTS );


use Getopt::LL qw(getoptions);



my $rules = {
    '--head'        => qr/(hello|goodbye)/xmsi,
    '--bottom'      => qr/\A\w+\z/xms,
            

};

my $getopt_options = {
   die_on_type_mismatch => 0,
   silent               => 1,
   allow_unspecified    => 1,
};

my $argv = [qw( --head hello --bottom )];
my $result = do { eval 'getoptions($rules, $getopt_options, $argv)' };
my $err = quotemeta
    'Argument --bottom [<no-value>] does not match /\A\w+\z/msx-i'
;
like( $EVAL_ERROR, qr/$err/, 'die on regex mismatch');

$argv = [qw( --head hello --bottom xyzzy )];
$result = do { eval 'getoptions($rules, $getopt_options, $argv)' };
is_deeply($result, { '--head' => 'hello', '--bottom' => 'xyzzy' }, 'regexes');

$argv = [qw( --head bonjour --bottom xyzzy )];
$result = do { eval 'getoptions($rules, $getopt_options, $argv)' };
$err = quotemeta
    'Argument --head [bonjour] does not match /(hello|goodbye)/msix'
;
like( $EVAL_ERROR, qr/$err/, 'die on regex mismatch');

$argv = [qw( --head goodbye --bottom x!x )];
$result = do { eval 'getoptions($rules, $getopt_options, $argv)' };
$err = quotemeta
    'Argument --bottom [x!x] does not match /\A\w+\z/msx-i'
;
like( $EVAL_ERROR, qr/$err/, 'die on regex mismatch');

package Getopt::LL;
use Test::More;

is(_regex_as_text(qr/((hello))/xms), '/((hello))/msx-i',
    '_regexp_as_text(qr/((hello))/xms)');
is(_regex_as_text(qr/(?:hello|olleh|leoh)/xms), '/(?:hello|olleh|leoh)/msx-i',
    '_regexp_as_text(qr/(?:hello|olleh|leoh)/xms)');

my $test_re = qr/
          \A          # starts with...
          -           # single dash.
          (?!-)       # with no dash after that.
          .
/xmsi;

is(_regex_as_text($test_re), '/
          \A          # starts with...
          -           # single dash.
          (?!-)       # with no dash after that.
          .
/msix');

is(_regex_as_text("(?:hello)"), '/hello/');

is(_regex_as_text("blablabla"), '/blablabla/');