💾 Archived View for thrig.me › blog › 2024 › 11 › 22 › matcher.pl captured on 2024-12-17 at 12:07:56.

View Raw

More Information

-=-=-=-=-=-=-

#!/usr/bin/env perl
# matcher - are test strings matched by some bit of code correctly?
use 5.36.0;

sub twore ($name) {
    if ( $name =~ m/\.[abc]$/ and not $name =~ m/bad/ ) {
        return 1;
    }
    return 0;
}

sub reval ($name) {
    if ( $name =~ m/ \.[abc]$ (?{ m!bad! ? 0 : 1 }) /x ) {
        return $^R;
    }
    return 0;
}

sub lookaround ($name) {
    if ($name =~ m/ ^              # step 1: match at beginning
                    (?s)           # (allow . to match newlines)
                    (?!.*bad)      # step 2: deny "bad"
                    (?=.*\.[abc]$) # step 3: accept "\.[abc]$"
                  /x) {
        return 1;
    }
    return 0;
}

sub instruct ($name) {
    $name =~ m/bad(*COMMIT)(*FAIL)|\.[abc]$/ ? 1 : 0
}
my $matcher = \&instruct;

while ( my $line = readline DATA ) {
    chomp $line;
    my ( $expect, $name ) = split ' ', $line, 2;
    my $got    = $matcher->($name);
    my $prefix = ( $got == $expect ) ? "okay" : "FAIL";
    say join "\t", $prefix, $expect, $got, $name;
}
__DATA__
1 good.a
1 good.b
1 good.c
0 bad.a
0 foobad.b
0 foobadbar.c
0 a.anope