my @strings = qw(aaabbbccc abc aaaaabbbbbccccc abbccc); print "\nAttempt 1\n"; foreach my $str ( @strings ) { print "$str: "; $_ = $str; while (s/^a(a*)b(b*)c(c*)$/$1$2$3/g) {}; print ($_ ? "Rejected" : "Accepted","\n"); }