#!/usr/local/bin/perl -sw
use strict ;
use lib 't' ;
use lib '..' ;
require 'common.pm' ;
my @sort_styles = qw( ST GRT ) ;
my @string_keys = map rand_alpha( 4, 8 ), 1 .. 10 ;
my @number_keys = map int rand_number( 100, 10000 ), 1 .. 10 ;
my $sort_tests = [
{
skip => 0,
source => 0,
name => 'init_code',
sizes => [400, 1000],
gen => sub { rand_choice( @string_keys ) . ':' .
rand_choice( @number_keys ) },
gold => sub {
($a =~ /^(\w+)/)[0] cmp ($b =~ /^(\w+)/)[0]
||
($a =~ /(\d+$)/)[0] <=> ($b =~ /(\d+$)/)[0]
},
args => {
init_code => [
init_code => 'my( $str, $num ) ;',
string =>
'do{( $str, $num ) = /^(\w+):(\d+)$/; $str}',
number => '$num',
],
no_init => [
string => '/^(\w+)/',
number => '/(\d+)$/'
],
},
},
{
skip => 0,
source => 0,
name => 'deep init_code',
sizes => [400, 1000],
gen => sub { [[{'a' => rand_choice( @string_keys ) . ':' .
rand_choice( @number_keys )}]] },
gold => sub {
($a->[0][0]{a} =~ /^(\w+)/)[0] cmp
($b->[0][0]{a} =~ /^(\w+)/)[0]
||
($a->[0][0]{a} =~ /(\d+$)/)[0] <=>
($b->[0][0]{a} =~ /(\d+$)/)[0]
},
args => {
init_code => [
init_code => 'my( $str, $num ) ;',
string => 'do{( $str, $num ) =
$_->[0][0]{a} =~ /^(\w+):(\d+)$/; $str}',
number => '$num',
],
no_init => [
string => '$_->[0][0]{a} =~ /^(\w+)/',
number => '$_->[0][0]{a} =~ /(\d+$)/',
],
},
},
] ;
common_driver( $sort_tests, \@sort_styles ) ;
exit ;