t/string_data.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( GRT ) ;
  12
  13 my @string_keys = map rand_alpha( 4, 8 ), 1 .. 100 ;
  14 my @number_keys = map int( rand_number( 100, 10000 ) ), 1 .. 100 ;
  15
  16 #print "STR @string_keys NUM @number_keys\n" ;
  17
  18 my $sort_tests = [
  19         {
  20                 skip    => 0,
  21                 name    => 'simple string',
  22                 sizes   => [100, 1000],
  23                 gen     => sub { rand_choice( @string_keys ) },
  24                 gold    => sub { $a cmp $b },
  25                 args    => {
  26                         string => [ qw( string_data string ) ],
  27                         index => [ qw( string ) ],
  28                 }
  29         },
  30         {
  31                 skip    => 0,
  32                 name    => 'simple string no-case',
  33                 sizes   => [100, 1000],
  34                 gen     => sub { rand_choice( @string_keys ) },
  35                 gold    => sub { uc($a) cmp uc($b) },
  36                 args    => {
  37                         string => [ qw( string_data string no_case ) ],
  38                         index => [ qw( string no_case ) ],
  39                 }
  40         },
  41         {
  42                 skip    => 0,
  43                 source  => 0,
  44                 name    => 'simple string descending',
  45                 sizes   => [100, 1000],
  46                 gen     => sub { rand_choice( @string_keys ) },
  47                 gold    => sub { $b cmp $a },
  48                 args    => {
  49                         string => [ qw( string_data string
  50                                         descending varying ) ],
  51                         index => [ qw( string descending varying ) ],
  52                 }
  53         },
  54         {
  55                 skip    => 0,
  56                 name    => 'simple string no-case descending',
  57                 sizes   => [100, 1000],
  58                 gen     => sub { rand_choice( @string_keys ) },
  59                 gold    => sub { uc($b) cmp uc($a) },
  60                 args    => {
  61                         string => [ qw( string_data string no_case
  62                                         descending varying ) ],
  63                         index => [ qw( string no_case descending varying ) ],
  64                 }
  65         },
  66         {
  67                 skip    => 0,
  68                 name    => 'simple number',
  69                 sizes   => [100, 1000],
  70                 gen     => sub { rand_choice( @number_keys ) },
  71                 gold    => sub { $a <=> $b },
  72                 args    => {
  73                         string => [ qw( string_data number ) ],
  74                         index => [ qw( number ) ],
  75                 }
  76         },
  77         {
  78                 skip    => 0,
  79                 source  => 0,
  80                 sizes   => [100, 1000],
  81                 name    => 'string:number',
  82                 gen     => sub { rand_choice( @string_keys ) . ':' .
  83                                  rand_choice( @number_keys )
  84                 },
  85                 gold    => sub {
  86                          ($a =~ /^(\w+)/)[0] cmp ($b =~ /^(\w+)/)[0]
  87                                 ||
  88                          ($a =~ /(\d+)$/)[0] <=> ($b =~ /(\d+)$/)[0]
  89                 },
  90                 args    => {
  91                         index   => [ string => '/^(\w+)/',
  92                                      number => '/(\d+)$/'
  93                         ],
  94                         string  => [ 'string_data',
  95                                      string => '/^(\w+)/',
  96                                      number => '/(\d+)$/'
  97                         ],
  98                 },
  99         },
 100 ] ;
 101
 102 common_driver( $sort_tests, \@sort_styles ) ;
 103
 104 exit ;