mixed-case.pl

#!/usr/bin/env perl
use 5.10.0;
use strict;
use warnings;
use Test::More 'no_plan';

my @rx = (
    qr/^ (\p{Upper}+|\p{Lower}+)+ \p{Upper}+ (\p{Lower}+|\p{Upper}+)* $/x,
    qr/^(?:[[:upper:]][[:lower:]])+[[:upper:]]?$/,
    qr/\b[[:upper:]][[:lower:]]+\b/,
    qr/[[:lower:]][[:upper:]]/,
);

my @want = ( qw[
    WoW 1
    foo 0
    Foo 0
    FOO 0
    FoO 1
    fOO 1
    foO 1
    foO 1
    GumbyBRAIN 1
    gumbyBRAIN 1
    HoRRiBlE 1
    HoRRiBle 1
    hoRRiBle 1
] );

my %res;
for my $rx (@rx) {
    diag "Testing regex $rx";
    subtest "$rx" => sub {
        plan tests => @want / 2;

        my @tmp = @want;
        while (my ($word, $should) = splice @tmp, 0, 2) {
            my $match = int $word =~ $rx;
            my $ret = is($should, $match, "Word $word is" . ($match ? " " : " not ") . "mixed case (match: $match) (should: $should)");
            $res{$rx} += $ret;
        }
    }
}

while (my ($k, $v) = each %res) {
    say sprintf "%02d/%d: %s", $v, @want / 2, $k;
}