t/init_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 my @sort_styles = qw( ST GRT ) ;
  10
  11 my @string_keys = map rand_alpha( 4, 8 ), 1 .. 10 ;
  12 my @number_keys = map int rand_number( 100, 10000 ), 1 .. 10 ;
  13
  14 my $sort_tests = [
  15
  16         {
  17                 skip    => 0,
  18                 source  => 0,
  19                 name    => 'init_code',
  20                 sizes   => [400, 1000],
  21                 gen     => sub { rand_choice( @string_keys ) . ':' .
  22                                  rand_choice( @number_keys ) },
  23                 gold    => sub {
  24                          ($a =~ /^(\w+)/)[0] cmp ($b =~ /^(\w+)/)[0]
  25                                         ||
  26                          ($a =~ /(\d+$)/)[0] <=> ($b =~ /(\d+$)/)[0]
  27                 },
  28                 args    => {
  29                         init_code => [
  30                                 init_code => 'my( $str, $num ) ;',
  31                                 string =>
  32                                   'do{( $str, $num ) = /^(\w+):(\d+)$/; $str}',
  33                                 number => '$num',
  34                         ],
  35                         no_init => [
  36                                 string => '/^(\w+)/',
  37                                 number => '/(\d+)$/'
  38                         ],
  39                 },
  40         },
  41         {
  42                 skip    => 0,
  43                 source  => 0,
  44                 name    => 'deep init_code',
  45                 sizes   => [400, 1000],
  46                 gen     => sub { [[{'a' => rand_choice( @string_keys ) . ':' .
  47                                  rand_choice( @number_keys )}]] },
  48                 gold    => sub {
  49                          ($a->[0][0]{a} =~ /^(\w+)/)[0] cmp
  50                          ($b->[0][0]{a} =~ /^(\w+)/)[0]
  51                                         ||
  52                          ($a->[0][0]{a} =~ /(\d+$)/)[0] <=>
  53                          ($b->[0][0]{a} =~ /(\d+$)/)[0]
  54                 },
  55                 args    => {
  56                         init_code => [
  57                                 init_code => 'my( $str, $num ) ;',
  58                                 string => 'do{( $str, $num ) =
  59                                         $_->[0][0]{a} =~ /^(\w+):(\d+)$/; $str}',
  60                                 number => '$num',
  61                         ],
  62                         no_init => [
  63                                 string => '$_->[0][0]{a} =~ /^(\w+)/',
  64                                 number => '$_->[0][0]{a} =~ /(\d+$)/',
  65                         ],
  66                 },
  67         },
  68 ] ;
  69
  70 common_driver( $sort_tests, \@sort_styles ) ;
  71
  72 exit ;