t/code.t

   1 #!/usr/local/bin/perl -sw
   2
   3 use strict ;
   4
   5 use lib 't' ;
   6 use lib '..' ;
   7 require 'common.pm' ;
   8
   9 use vars '$bench' ;
  10
  11 #my @sort_styles = qw( plain ) ;
  12 my @sort_styles = qw( plain orcish ST GRT ) ;
  13
  14 #my @string_keys = map rand_alpha( 4, 8 ), 1 .. 5 ;
  15 my @string_keys = map rand_alpha( 4, 8 ), 1 .. 100 ;
  16
  17 #print "STR @string_keys NUM @number_keys\n" ;
  18
  19 my $sort_tests = [
  20         {
  21                 skip    => 0,
  22                 name    => 'regex code',
  23                 gen     => sub { rand_choice( @string_keys ) },
  24                 gold    => sub { ($a =~ /(\w+)/)[0] cmp ($b =~ /(\w+)/)[0] },
  25                 args    => {
  26                         string  => [ qw( string /(\w+)/ ) ],
  27                         qr      => [ string => qr/(\w+)/ ],
  28                         code    => [ string => sub { /(\w+)/ } ],
  29                 }
  30         },
  31         {
  32                 skip    => 0,
  33                 name    => 'array code',
  34                 data    => [ map {
  35                                 [ rand_token( 8, 20 ) ]
  36                         } 1 .. 100
  37                 ],
  38                 gold    => sub { $a->[0] cmp $b->[0] },
  39                 args    => {
  40                         string  => [ qw( string $_->[0] ) ],
  41                         code    => [ string => sub { $_->[0] } ],
  42                 }
  43         },
  44         {
  45                 skip    => 0,
  46                 name    => 'hash code',
  47                 data    => [ map {
  48                                 { a => rand_token( 8, 20 ) }
  49                         } 1 .. 100
  50                 ],
  51                 gold    => sub { $a->{a} cmp $b->{a} },
  52                 args    => {
  53                         string  => [ qw( string $_->{a} ) ],
  54                         code    => [ string => sub { $_->{a} } ],
  55                 }
  56         },
  57 ] ;
  58
  59 common_driver( $sort_tests, \@sort_styles ) ;
  60
  61 exit ;