t/sort.t

   1 #!/usr/local/bin/perl -w
   2
   3 use strict ;
   4
   5 use Test::More ;
   6 use Carp ;
   7
   8 my $ok ;
   9
  10 use Sort::Maker qw( sorter_source ) ;
  11
  12
  13 BEGIN{
  14
  15         $ok = use_ok( 'Sort::Maker' ) ;
  16 print "OK [$ok] $@\n" ;
  17
  18 }
  19 #print "FOO\n" ;
  20
  21 my @sort_tests = (
  22
  23         {
  24                 skip    => 0,
  25                 name    => 'simple string',
  26                 data    => [ qw( z e a k ) ],
  27                 sort    => sub { $a cmp $b },
  28                 opts    => [ qw( string ) ],
  29         },
  30         {
  31                 skip    => 0,
  32                 name    => 'simple number',
  33                 data    => [ 32, 2, 9, 7 ],
  34                 sort    => sub { $a <=> $b },
  35                 opts    => [ qw( number ) ],
  36         },
  37         {
  38                 skip    => 0,
  39                 name    => 'simple string ref_in',
  40                 data    => [ qw( z e a k ) ],
  41                 sort    => sub { $a cmp $b },
  42                 opts    => [ qw( ref_in string ) ],
  43                 ref_in  => 1,
  44         },
  45         {
  46                 skip    => 0,
  47                 name    => 'simple string ref_out',
  48                 data    => [ qw( z e a k ) ],
  49                 sort    => sub { $a cmp $b },
  50                 opts    => [ qw( ref_out string ) ],
  51                 ref_out => 1,
  52         },
  53 ) ;
  54
  55 plan tests => @sort_tests * 2 ;
  56
  57 foreach my $test ( @sort_tests ) {
  58
  59         next if $test->{skip} ;
  60
  61         my( $name, $data, $sort, $opts ) = @{$test}{qw( name data sort opts )} ;
  62
  63         my @sorted = sort { $sort->() } @{$data} ;
  64
  65 #print "gold SORTED [@sorted]\n" ;
  66
  67         foreach my $style ( qw( plain ST ) ) {
  68
  69                 my $sorter = make_sorter( $style, @{$opts} ) ;
  70
  71 print "SORT [$sorter] [$@]\n" ;
  72
  73 print sorter_source( $sorter ) || '' ;
  74
  75 die unless $sorter ;
  76
  77                 my @in = $test->{ref_in} ? $data : @{$data} ;
  78
  79                 my @test_sorted = $sorter->( @in ) ;
  80
  81                 @test_sorted = @{$test_sorted[0]} if $test->{ref_out} ;
  82
  83 #print "style SORTED [@test_sorted]\n" ;
  84
  85                 ok( eq_array( \@sorted, \@test_sorted ),
  86                         "$style sort of $name" ) ;
  87         }
  88 }