#!/usr/bin/perl

use strict;
use lib "blib/lib";

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

use warnings;


BEGIN {$^W = 0 if $] < 5.006}

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.
    # Not for pre 5.006 perls due to tests taking too much time.
    push @bad_comments => map {"$start$_"} @comments if $] >= 5.006;
    # 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 => 'Regexp::Common::comment',


__END__