t/closure.t

   1 #!/usr/local/bin/perl -s
   2
   3 use strict ;
   4 use warnings ;
   5
   6 use lib 't' ;
   7 use lib '..' ;
   8 require 'common.pm' ;
   9
  10 use vars '$bench' ;
  11
  12 #my @sort_styles = qw( plain ) ;
  13 my @sort_styles = qw( plain orcish ST GRT ) ;
  14
  15 # These are some months to be sorted numerically.
  16 my @months = qw(
  17         January
  18         February
  19         March
  20         April
  21         May
  22         June
  23         July
  24         August
  25         September
  26         October
  27         November
  28         December
  29 ) ;
  30
  31 # a jumbled array of months to be sorted
  32
  33 my @month_jumble = qw(February June October March January
  34         April July November August December May September);
  35
  36 my %month_to_num ;
  37 @month_to_num{ @months } = 1 .. @months ;
  38
  39 # These are some months to be sorted alphabetically
  40 # (order determined by letters).
  41
  42 my %month_to_let ;
  43 @month_to_let{ @months } = 'A' .. 'L' ;
  44
  45 my $sort_tests = [
  46
  47         {
  48                 skip    => 0,
  49                 name    => 'closure error',
  50                 gold    => sub { $month_to_num{$a} <=> $month_to_num{$b} },
  51                 error   => qr/Global symbol "%month_to_num"/,
  52                 args    => {
  53                         number => [
  54                                 number => sub { $month_to_num{$_} },
  55                         ],
  56                 },
  57         },
  58
  59         {
  60                 skip    => 0,
  61                 source  => 0,
  62                 name    => 'closure numeric',
  63                 data    => \@month_jumble,
  64                 gold => sub { $month_to_num{$a} <=> $month_to_num{$b} },
  65                 args    => {
  66                         number => [
  67                                 'closure',
  68                                 number => sub { $month_to_num{$_} },
  69                         ],
  70                 },
  71         },
  72
  73         {
  74                 skip    => 0,
  75                 source  => 0,
  76                 name    => 'closure string',
  77                 data    => \@month_jumble,
  78                 gold => sub { $month_to_let{$a} cmp $month_to_let{$b} },
  79                 args    => {
  80                         string => [
  81                                 'closure',
  82                                 string => sub { $month_to_let{$_} },
  83                         ],
  84                 },
  85         },
  86
  87         {
  88                 skip    => 0,
  89                 name    => 'double closure',
  90                 data    => [
  91                         [ qw( November March ) ],
  92                         [ qw( January March ) ],
  93                         [ qw( July June ) ],
  94                         [ qw( January January ) ],
  95                 ],
  96                 gold    => sub {
  97                         $month_to_let{$a->[0]} cmp $month_to_let{$b->[0]}
  98                                 ||
  99                         $month_to_num{$a->[1]} <=> $month_to_num{$b->[1]}
 100                 },
 101                 args    => {
 102                         double => [
 103                                 'closure',
 104                                 string  => sub { $month_to_let{$_->[0]} },
 105                                 number  => sub { $month_to_num{$_->[1]} },
 106                          ],
 107                 },
 108         },
 109 ] ;
 110
 111 common_driver( $sort_tests, \@sort_styles ) ;
 112
 113 exit ;