-----------------8<---------8<------------------ use Benchmark qw(cmpthese); sub reveal { my $t; ($t = $_[0]) =~ s/\cH/\\b/g; $t; } my %methodstocheck = ( 'uk()' => \&uk_for_check, 'new1()' => \&new1, 'smack()' => \&smack, 'smacknew()' => \&smacknew, 'badkcams()' => \&badkcams_for_check, 'othersmack()' => \&othersmack, ); my %methodstotest = ( 'uk()' => \&uk, 'new1()' => \&new1, 'smack()' => \&smack, 'smacknew()' => \&smacknew, 'badkcams()' => \&badkcams, 'othersmack()' => \&othersmack, ); my %teststrings = ( smackem => [ "\bthis is an\b correct\b\b\b usage\b", "this is a corr usag", ], ukky => [ "\bMy first attempt was slightly\b\b\b\b\b\b\b\bvery buggy, maybe thus\b\bis wa\b\bis better??\b", "My first attempt was very buggy, maybe this is better?", ], riced => [ "\bt\b\bhello", "hello", ], ); my @passedtests; print "\nChecking methods for corrrect results:\n"; foreach my $methodname (sort keys %methodstocheck) { printf " Testing method '%s' ...\n", $methodname; my $rmethod = $methodstocheck{$methodname}; my $notok; foreach my $testname (sort keys %teststrings) { $s = $teststrings{$testname}[0]; $x = $teststrings{$testname}[1]; my $result = &{$rmethod}(); if( $x ne $result ) { ++$notok; printf " Method '%s' failed test '%s'\n", $methodname, $testname; printf " Expecting '%s'\n", reveal($x); printf " Result was '%s'\n", reveal($result); } } if( $notok ) { # printf " Method '%s' failed %d tests\n", $methodname, $notok; } else { # printf " Method '%s' passes tests\n", $methodname; push @passedtests, $methodname; } } printf "\n %d tests passed, will benchmark '%s'\n", scalar(@passedtests), join("', '",@passedtests); my %benchmark = map { $_, $methodstotest{$_} } @passedtests; $s = "\bthis is an\b correct\b\b\b usage\b"; $s = "\bt\b\bhello"; $s = "\bMy first attempt was slightly\b\b\b\b\b\b\b\bvery buggy, maybe thus\b\bis wa\b\bis better??\b"; cmpthese(-1, \%benchmark ); $s x= 100; cmpthese(-1, \%benchmark ); sub uk_for_check { $a = $s; my $awhile = 256; $a =~ s[(?:[^\cH]\cH|^\cH)][]g while $awhile-- && (1+index($a,chr(8))); $a .= ' but loops!' unless $awhile > 0; $a; } sub uk { $a = $s; $a =~ s[(?:[^\cH]\cH|^\cH)][]g while 1+index $a, chr(8); $a; } sub new1 { $a = $s; while ($a =~ s/(?:[^\cH]\cH|^\cH+)//g) {} $a; } sub smack { $a = $s; do 1 while ($a =~ s/(?:[^\cH]\cH|^\cH+)//g); $a; } sub smacknew { $a = $s; $a =~ s/^\cH+//; 1 while ($a =~ s/[^\cH]\cH//g); $a; } sub othersmack { $a = $s; 1 while ($a =~ s/[^\cH]\cH//g); $a =~ s/^\cH+//; $a; } sub badkcams_for_check { $a = reverse $s; my $awhile = 256; $a =~ s[\cH[^\cH]|\cH$][]g while $awhile-- && (1+index($a,chr(8))); $a = reverse $a; $a .= ' but loops!' unless $awhile > 0; $a; } sub badkcams { $a = reverse $s; $a =~ s[\cH[^\cH]|\cH$][]g while 1+index $a, chr(8); reverse $a; } __END__ Checking methods for corrrect results: Testing method 'badkcams()' ... Testing method 'new1()' ... Testing method 'othersmack()' ... Testing method 'smack()' ... Testing method 'smacknew()' ... Method 'smacknew()' failed test 'riced' Expecting 'hello' Result was '\bhello' Testing method 'uk()' ... 5 tests passed, will benchmark 'badkcams()', 'new1()', 'othersmack()', 'smack( )', 'uk()' Rate smack() new1() uk() badkcams() othersmack() smack() 188/s -- -96% -97% -97% -99% new1() 5067/s 2594% -- -7% -24% -86% uk() 5470/s 2808% 8% -- -17% -85% badkcams() 6624/s 3422% 31% 21% -- -82% othersmack() 37522/s 19850% 641% 586% 466% -- Rate smack() new1() uk() badkcams() othersmack() smack() 42.1/s -- -23% -31% -45% -93% new1() 55.0/s 31% -- -10% -28% -91% uk() 61.4/s 46% 12% -- -20% -90% badkcams() 76.9/s 83% 40% 25% -- -88% othersmack() 632/s 1400% 1048% 929% 721% -- -----------------8<---------8<------------------