t/99-benchmark-bool.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More 0.94 tests => 5;    # last test to print
   5
   6 for my $class (qw/Perlbal Perlbal::Service/) {
   7     use_ok( $class, "can load module $class" );
   8 }
   9
  10 my $class = 'Perlbal::Service';
  11
  12 subtest 'module checking' => sub {
  13     isa_ok( $class->new(), $class, "can create object from $class" );
  14     done_testing();
  15 };
  16
  17 my @words = generate_words(1000);
  18
  19 subtest 'check sub integrity' => sub {
  20     is_deeply( test_optimized(), test_original(), "sub optimized" );
  21     is_deeply( test_hash(),      test_original(), "sub hash" );
  22     done_testing();
  23 };
  24
  25 SKIP: {
  26     skip "need Benchmark module", 1 unless eval "require Benchmark";
  27
  28     subtest 'benchmark bool sub' => sub {
  29         use_ok('Benchmark');
  30         timethese(
  31             shift || 100000,
  32             {
  33                 'void' => sub {
  34                     map { 1 } @words;
  35                 },
  36                 'original'  => \&test_original,
  37                 'optimized' => \&test_optimized,
  38                 'hash'      => \&test_hash,
  39             }
  40         );
  41         done_testing();
  42     };
  43
  44 }
  45
  46 done_testing();
  47
  48 # helpers
  49
  50 sub test_original {
  51     map { _bool_original($_) } @words;
  52 }
  53
  54 sub test_optimized {
  55     map { _bool_optimized($_) } @words;
  56 }
  57
  58 sub test_hash {
  59     map { Perlbal::Service::_bool($_) } @words;
  60 }
  61
  62 sub _bool_original {
  63     my $val = shift;
  64
  65     return unless defined $val;
  66
  67     return 1 if $val =~ /^1|true|on|yes$/i;
  68     return 0 if $val =~ /^0|false|off|no$/i;
  69     return undef;
  70 }
  71
  72 {
  73
  74     # should use state
  75     my $qr_on;
  76     my $qr_off;
  77
  78     sub _bool_optimized {
  79         my $val = shift;
  80
  81         return unless defined $val;
  82
  83         $qr_on  = qr/^1|true|on|yes$/i  unless defined $qr_on;
  84         $qr_off = qr/^0|false|off|no$/i unless defined $qr_off;
  85
  86         return 1 if $val =~ $qr_on;
  87         return 0 if $val =~ $qr_off;
  88         return undef;
  89     }
  90 }
  91
  92 sub generate_words {
  93     my $n = shift || 10;
  94     my @words = qw/1 true on yes 0 false off no/;
  95
  96     my $reply = [];
  97
  98     for ( 1 .. $n ) {
  99         my $w = $words[ int rand( scalar @words ) ];
 100
 101         if ( rand(3) > 1 ) {
 102             if ( rand(2) > 1 ) {
 103                 $w = uc($w);
 104             }
 105             else {
 106                 my $l = length $w;
 107                 for my $c ( 1 .. $l ) {
 108                     next if ( rand(2) > 1 );
 109                     substr( $w, $c - 1, 1 ) = uc( getn_substr( $w, $c ) );
 110                 }
 111             }
 112         }
 113         push( @$reply, $w );
 114     }
 115
 116     return $reply;
 117 }
 118
 119 sub getn_substr {
 120     return substr $_[0], $_[1] - 1, 1;
 121 }
 122