#!/usr/bin/perl

use strict;
use lib "blib/lib", ".";

use Regex::Common qw /RE_comment_ALL/;
use t::Common     qw /run_new_tests/;

use warnings;

my @delimited = do {
    no warnings;
    (
        [ qw {comment  ;} => ['Algol 60'] ],
        [ qw {/*      */} => [qw {ALPACA B C C-- LPC PL/I}] ],
        [ qw {;        ;} => [qw {Befunge-98 Funge-98 Shelta}] ],
        [ qw {<?_c  _c?>} => [qw {BML}] ],
        [ qw !{        }! => [qw {False}] ],
        [ qw {,        ,} => [qw {Haifu}] ],
        [ qw {/**     */} => [qw {JavaDoc}] ],
        [ qw {(*      *)} => [qw {Oberon}] ],
        [ qw {"        "} => [qw {Smalltalk}] ],
        [ qw {||      !!} => [qw {*W}] ],
    );
};

#
# Some basic comments, not including delimiters.
#
my @comments = (
    "",
    "This is a comment",
    "This is a\nmultiline comment",
    "\n", "*", "\n*\n", "/*", "(*", "||", "{"
);

# Targets, and test suites.
my %targets;
my @tests;

foreach my $entry (@delimited) {
    my ( $start, $end ) = @$entry[ 0, 1 ];
    my $langs    = $$entry[2];
    my $pass_key = "pass_${start}_${end}";
    my $fail_key = "fail_${start}_${end}";

    $targets{$pass_key} = {
        list   => \@comments,
        query  => sub { $start . $_[0] . $end },
        wanted => sub { $_, $start, $_[0], $end },
    };

    # Create bad comments.
    my @bad_comments;

    # No terminating token.
    push @bad_comments => map { "$start$_" } @comments;

    # No starting token.
    push @bad_comments => map { "$_$end" }
      grep { index( $_, $start ) } @comments;

    # Double terminators.
    push @bad_comments => map { "$start$_$end$end" } @comments;

    # Double the comment.
    push @bad_comments => map { "$start$_$end" x 2 } @comments;

    # Different token.
    my @bad_tokens = grep { index $_->[0], $start } @delimited;
    push @bad_comments => map {
        my $c = $_;
        map { $_->[0] . $c . $_->[1] } @bad_tokens
    } @comments;

    # No tokens.
    push @bad_comments => @comments;

    # Text preceeding comment.
    push @bad_comments => map { "Text $start$_$end" } @comments;

    # Some more.
    push @bad_comments => "<!-- This is an HTML  comment -->";
    push @bad_comments => "/*   This is a C      comment */" if $start ne '/*';
    push @bad_comments => "{    This is a Pascal comment }"  if $start ne '{';

    $targets{$fail_key} = { list => \@bad_comments, };

    foreach my $lang (@$langs) {
        my $langX = $lang;
        $langX =~ s/\W/X/g;
        no strict 'refs';
        push @tests => {
            name     => $lang,
            regex    => $RE{comment}{$lang},
            sub      => \&{"RE_comment_$langX"},
            pass     => [$pass_key],
            fail     => [$fail_key],
            skip_sub => sub {
                $lang eq 'JavaDoc'
                  && $_[0] eq 'fail'
                  && $_[1] eq '/***/';
            },
        };
    }
}

run_new_tests
  tests        => \@tests,
  targets      => \%targets,
  version_from => 'Regex::Common::comment',

__END__
