view release on metacpan or  search on metacpan

share/RegexpCommonTS/t/test_comments.t  view on Meta::CPAN

# VOODOO LINE-NOISE
my($C,$M,$P,$N,$S);END{print"1..$C\n$M";print"\nfailed: $N\n"if$N}
sub ok{$C++; $M.= ($_[0]||!@_)?"ok $C\n":($N++,"not ok $C (".
((caller 1)[1]||(caller 0)[1]).":".((caller 1)[2]||(caller 0)[2]).")\n")}
sub try{$P=qr/^$_[0]$/}sub fail{ok($S=$_[0]!~$P)}sub pass{ok($S=$_[0]=~$P)}

sub try2  {$P = qr /$_[0]$/}
sub pass2 {ok ($S=($_[0] =~ $P && $& eq $_[1]))}
sub fail2 {ok ($S=($_[0] !~ $P || $& ne $_[1]))}

# LOAD

use Regexp::Common;
ok;

my @ids = (
   ['"'      =>  [[Pascal => 'Workshop']]],
);

my @from_to = (
   [[[Pascal => 'Workshop']] =>  "/*", "*/"],

   [[qw /Pascal/, [Pascal => 'Workshop']] =>  "{",  "}"],

   [[qw /Pascal/, [Pascal => 'Workshop']] =>  "(*", "*)"],

   [[qw /Pascal/]                =>  "{", "*)"],
   [[qw /Pascal/]                =>  "(*", "}"],

);


foreach my $info (@ids) {
    my ($mark, $languages) = @$info;
    my $not_mark = $mark eq '#' ? '!' : '#';
    foreach my $language (@$languages) {
        if (ref $language) {
            try $RE{comment}{$language -> [0]}{$language -> [1]};
            $language = join ":" => @$language;
        }
        else {
            try $RE{comment}{$language};
        }

        $M .= "# $language\n";

        pass qq !${mark}${mark}!;
        pass qq !${mark}a comment${mark}!;
        pass qq !${mark}/*a comment */${mark}!;
        pass qq !${mark}/************${mark}!;
        pass qq !${mark}/////////////${mark}!;
        fail qq !${mark}a${mark}${mark}multiline${mark}${mark}comment${mark}!;
        fail qq !${mark}a comment!;
        fail qq !${mark}/*a comment */!;
        fail qq !${mark}/************!;
        fail qq !${mark}/////////////!;
        fail qq !${not_mark}${mark}!;
        fail qq !${not_mark}a comment${mark}!;
        fail qq !${not_mark}/*a comment */${mark}!;
        fail qq !${not_mark}/************${mark}!;
        fail qq !${not_mark}${mark}////////////${mark}!;
        fail qq !//a comment${mark}!;
        fail qq !///*a comment */${mark}!;
        fail qq !///************${mark}!;
        fail qq !///////////////${mark}!;
        fail qq !//a${mark}//multiline${mark}//comment${mark}!;
        fail qq !//a comment!;
        fail qq !///*a comment */!;
        fail qq !///************!;
        fail qq !///////////////!;
        next if $language eq 'Pascal:Workshop';
        fail qq !/*a comment */!;
        fail qq !/************/!;
        fail qq !/*a${mark}multiline${mark}comment*/!;
        fail qq !/*a /*pretend*/ nested comment*/!;
        fail qq !/*a /*pretend*/!;
    }
}

foreach my $info (@from_to) {
    my ($languages, $from, $to) = @$info;
    my $f = substr $from => 0, 1;
    my $t = substr $to   => 0, 1;

    foreach my $language (@$languages) {
        if (ref $language) {
            try $RE{comment}{$language -> [0]}{$language -> [1]};
            $language = join ":" => @$language;
        }
        else {
            try $RE{comment}{$language};
        }

        my $mark = $language eq 'Nickle' ? ';' : '#';

        $M .= "# $language\n";

        pass "${from}a comment ${to}";
        my @str = ("${from}${t}${t}${t}${t}${t}${t}${t}${t}${t}${t}${to}",
                   "${from}${t}${to}",
        );
        if (${to} =~ /^(?:\Q${t}\E)+$/) {fail $_ for @str;}
        else                            {pass $_ for @str;}
        if ($language eq 'Pascal:Alice') {
            fail "${from}a\nmultiline\ncomment${to}";
        }
        else {
            pass "${from}a\nmultiline\ncomment${to}";
        }
        pass "${from}${to}";
        fail "${from}a ${from}pretend${to} nested comment${to}";
        pass "${from}a ${from}pretend${to}";
        pass "${from} {) ${to}";
        fail "${from}${t}${t}${t}${t}${t}${t}${t}${t}${t}${t}";
        fail "${mark}\n";
        fail "${mark}a comment\n";
        fail "${mark}${from}a comment ${to}\n";
        fail "${mark}${from}${t}${t}${t}${t}${t}${t}${t}${t}${t}${t}${t}\n";
        fail "${mark}${f}${f}${f}${f}${f}${f}${f}${f}${f}${f}${f}${f}${f}\n";
        fail "${mark}a\n${mark}multiline\n${mark}comment\n";
        fail "${mark}a comment";