t/GRT.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( GRT ) ;
  10
  11 my $sort_tests = [
  12
  13         {
  14                 skip    => 0,
  15                 name    => 'simple string',
  16                 data    => [ qw( z e a k ) ],
  17                 gold    => sub { $a cmp $b },
  18                 args    => [ qw( string ) ],
  19         },
  20         {
  21                 skip    => 0,
  22                 name    => 'unsigned integer',
  23                 data    => [ 32, 2, 9, 7 ],
  24                 gold    => sub { $a <=> $b },
  25                 args    => [ qw( unsigned number ) ],
  26         },
  27         {
  28                 skip    => 0,
  29                 name    => 'unsigned integer descending',
  30                 data    => [ 32, 2, 9, 7 ],
  31                 gold    => sub { $b <=> $a },
  32                 args    => [ qw( unsigned number descending ) ],
  33         },
  34         {
  35                 skip    => 0,
  36                 name    => 'signed integer',
  37                 data    => [ 32, -2, 9, -7 ],
  38                 gold    => sub { $a <=> $b },
  39                 args    => [ qw( signed number ) ],
  40         },
  41         {
  42                 skip    => 0,
  43                 name    => 'signed integer descending',
  44                 data    => [ 32, -2, 9, -7 ],
  45                 gold    => sub { $b <=> $a },
  46                 args    => [ qw( signed number descending ) ],
  47         },
  48         {
  49                 skip    => 0,
  50                 name    => 'unsigned float',
  51                 data    => [ 32, 2, 9, 7 ],
  52                 gold    => sub { $a <=> $b },
  53                 args    => [ qw( unsigned_float number ) ],
  54         },
  55         {
  56                 skip    => 0,
  57                 name    => 'unsigned float descending',
  58                 data    => [ 32, 2, 9, 7.0, 7.1 ],
  59                 gold    => sub { $b <=> $a },
  60                 args    => [ qw( unsigned_float number descending ) ],
  61         },
  62         {
  63                 skip    => 0,
  64                 name    => 'signed float',
  65                 data    => [ 32, -2, 9, -7 ],
  66                 gold    => sub { $a <=> $b },
  67                 args    => [ qw( signed_float number ) ],
  68         },
  69         {
  70                 skip    => 0,
  71                 name    => 'signed float descending',
  72                 data    => [ 32, -2, 9, -7.0, -7.1 ],
  73                 gold    => sub { $b <=> $a },
  74                 args    => [ qw( signed_float number descending ) ],
  75         },
  76         {
  77                 skip    => 0,
  78                 name    => 'plain string',
  79                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ) ],
  80                 gold    => sub { $a cmp $b },
  81                 args    => [ qw( string ) ],
  82         },
  83         {
  84                 skip    => 0,
  85                 name    => 'plain string no_case',
  86                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ) ],
  87                 gold    => sub { uc $a cmp uc $b },
  88                 args    => [ qw( no_case string ) ],
  89         },
  90         {
  91                 skip    => 0,
  92                 name    => 'fixed string',
  93                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
  94                 gold    => sub { $a cmp $b },
  95                 args    => [ qw( string fixed 6 ) ],
  96         },
  97         {
  98                 skip    => 0,
  99                 name    => 'string no_case fixed',
 100                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 101                 gold    => sub { uc $a cmp uc $b },
 102                 args    => [ qw( string no_case fixed 6 ) ],
 103         },
 104         {
 105                 skip    => 0,
 106                 name    => 'string descending fixed',
 107                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 108                 gold    => sub { $b cmp $a },
 109                 args    => [ qw( string descending fixed 6 ) ],
 110         },
 111         {
 112                 skip    => 0,
 113                 name    => 'string no_case descending fixed',
 114                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 115                 gold    => sub { uc $b cmp uc $a },
 116                 args    => [ qw( string no_case descending fixed 6 ) ],
 117         },
 118
 119         {
 120                 skip    => 0,
 121                 name    => 'varying string',
 122                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 123                 gold    => sub { $a cmp $b },
 124                 args    => [ qw( string varying ) ],
 125         },
 126         {
 127                 skip    => 0,
 128                 name    => 'string no_case varying',
 129                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 130                 gold    => sub { uc $a cmp uc $b },
 131                 args    => [ qw( string no_case varying ) ],
 132         },
 133         {
 134                 skip    => 0,
 135                 name    => 'string descending varying',
 136                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 137                 gold    => sub { $b cmp $a },
 138                 args    => [ qw( string descending varying ) ],
 139         },
 140         {
 141                 skip    => 0,
 142                 name    => 'string no_case descending varying',
 143                 data    => [ qw( bdhd BDhd wxj ayewwq rjjx ), "w\0j" ],
 144                 gold    => sub { uc $b cmp uc $a },
 145                 args    => [ qw( string no_case descending varying ) ],
 146         },
 147 ] ;
 148
 149 common_driver( $sort_tests, \@sort_styles ) ;
 150
 151 exit ;