t/snippets28.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 olbxl.olbxl2
   5 #2 recombine5.def
   6 #3 recombine6.def
   7 #4 recombine7.def
   8 #5 recombine8.def
   9
  10 # To locate test #13 you can search for its name or the string '#13'
  11
  12 use strict;
  13 use Test::More;
  14 use Carp;
  15 use Perl::Tidy;
  16 my $rparams;
  17 my $rsources;
  18 my $rtests;
  19
  20 BEGIN {
  21
  22     ###########################################
  23     # BEGIN SECTION 1: Parameter combinations #
  24     ###########################################
  25     $rparams = {
  26         'def'    => "",
  27         'olbxl2' => <<'----------',
  28 -olbxl='*'
  29 ----------
  30     };
  31
  32     ############################
  33     # BEGIN SECTION 2: Sources #
  34     ############################
  35     $rsources = {
  36
  37         'olbxl' => <<'----------',
  38             eval {
  39                require Ace };
  40
  41             @list = map {
  42                 $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
  43             } @list;
  44
  45             $color = join(
  46                 '/',
  47                 sort {
  48                     $color_value{$::a} <=> $color_value{$::b};
  49                 } keys %colors
  50             );
  51
  52             @sorted = sort {
  53                 $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
  54                 };
  55 ----------
  56
  57         'recombine5' => <<'----------',
  58 # recombine uses reverse optimization
  59 $rotate = Math::MatrixReal->new_from_string( "[ " . cos($theta) . " " . -sin($theta) . " ]\n" . "[ " . sin($theta) . " " . cos($theta) . " ]\n" );
  60 ----------
  61
  62         'recombine6' => <<'----------',
  63 # recombine operation uses forward optimization
  64         $filecol =
  65             (/^$/)     ? $filecol                                        :
  66             (s/^\+//)  ? $filecol  + $_                                  :
  67             (s/^\-//)  ? $filecol  - $_                                  :
  68             (s/^>//)   ? ($filecol + $_) % $pages                        :
  69             (s/^]//)   ? (($filecol + $_ >= $pages) ? 0 : $filecol + $_) :
  70             (s/^<//)   ? ($filecol - $_) % $pages                        :
  71             (s/^\[//)  ? (($filecol == 0) ? $pages - ($pages % $_ || $_) :
  72                           ($filecol - $_ < 0) ? 0 : $filecol - $_)       :
  73             (/^\d/)    ? $_ - 1                                          :
  74             (s/^\\?//) ? (($col{$_}, $row{$_}) = &pageto($_))[0]         : 0;
  75 ----------
  76
  77         'recombine7' => <<'----------',
  78     # recombine uses forward optimization, must recombine at =
  79     my $J = int( 365.25 * ( $y + 4712 ) ) +
  80       int( ( 30.6 * $m ) + 0.5 ) + 59 + $d - 0.5;
  81 ----------
  82
  83         'recombine8' => <<'----------',
  84 # recombine uses normal forward mode
  85 $v_gb = -1*(eval($pmt_gb))*(-1+((((-1+(1/((eval($i_gb)/100)+1))**  ((eval($n_gb)-1)))))/(eval($i_gb)/100)));
  86 ----------
  87     };
  88
  89     ####################################
  90     # BEGIN SECTION 3: Expected output #
  91     ####################################
  92     $rtests = {
  93
  94         'olbxl.olbxl2' => {
  95             source => "olbxl",
  96             params => "olbxl2",
  97             expect => <<'#1...........',
  98             eval {
  99                 require Ace;
 100             };
 101
 102             @list = map {
 103                 $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
 104             } @list;
 105
 106             $color = join(
 107                 '/',
 108                 sort {
 109                     $color_value{$::a} <=> $color_value{$::b};
 110                 } keys %colors
 111             );
 112
 113             @sorted = sort {
 114                 $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
 115             };
 116 #1...........
 117         },
 118
 119         'recombine5.def' => {
 120             source => "recombine5",
 121             params => "def",
 122             expect => <<'#2...........',
 123 # recombine uses reverse optimization
 124 $rotate =
 125   Math::MatrixReal->new_from_string( "[ "
 126       . cos($theta) . " "
 127       . -sin($theta) . " ]\n" . "[ "
 128       . sin($theta) . " "
 129       . cos($theta)
 130       . " ]\n" );
 131 #2...........
 132         },
 133
 134         'recombine6.def' => {
 135             source => "recombine6",
 136             params => "def",
 137             expect => <<'#3...........',
 138         # recombine operation uses forward optimization
 139         $filecol =
 140             (/^$/)    ? $filecol
 141           : (s/^\+//) ? $filecol + $_
 142           : (s/^\-//) ? $filecol - $_
 143           : (s/^>//)  ? ( $filecol + $_ ) % $pages
 144           : (s/^]//)  ? ( ( $filecol + $_ >= $pages ) ? 0 : $filecol + $_ )
 145           : (s/^<//)  ? ( $filecol - $_ ) % $pages
 146           : (s/^\[//) ? (
 147               ( $filecol == 0 )     ? $pages - ( $pages % $_ || $_ )
 148             : ( $filecol - $_ < 0 ) ? 0
 149             :                         $filecol - $_
 150           )
 151           : (/^\d/)    ? $_ - 1
 152           : (s/^\\?//) ? ( ( $col{$_}, $row{$_} ) = &pageto($_) )[0]
 153           :              0;
 154 #3...........
 155         },
 156
 157         'recombine7.def' => {
 158             source => "recombine7",
 159             params => "def",
 160             expect => <<'#4...........',
 161     # recombine uses forward optimization, must recombine at =
 162     my $J = int( 365.25 * ( $y + 4712 ) ) +
 163       int( ( 30.6 * $m ) + 0.5 ) + 59 + $d - 0.5;
 164 #4...........
 165         },
 166
 167         'recombine8.def' => {
 168             source => "recombine8",
 169             params => "def",
 170             expect => <<'#5...........',
 171 # recombine uses normal forward mode
 172 $v_gb = -1 * ( eval($pmt_gb) ) * (
 173     -1 + (
 174         (
 175             (
 176                 (
 177                     -1 + ( 1 / ( ( eval($i_gb) / 100 ) + 1 ) )
 178                       **( ( eval($n_gb) - 1 ) )
 179                 )
 180             )
 181         ) / ( eval($i_gb) / 100 )
 182     )
 183 );
 184 #5...........
 185         },
 186     };
 187
 188     my $ntests = 0 + keys %{$rtests};
 189     plan tests => $ntests;
 190 }
 191
 192 ###############
 193 # EXECUTE TESTS
 194 ###############
 195
 196 foreach my $key ( sort keys %{$rtests} ) {
 197     my $output;
 198     my $sname  = $rtests->{$key}->{source};
 199     my $expect = $rtests->{$key}->{expect};
 200     my $pname  = $rtests->{$key}->{params};
 201     my $source = $rsources->{$sname};
 202     my $params = defined($pname) ? $rparams->{$pname} : "";
 203     my $stderr_string;
 204     my $errorfile_string;
 205     my $err = Perl::Tidy::perltidy(
 206         source      => \$source,
 207         destination => \$output,
 208         perltidyrc  => \$params,
 209         argv        => '',             # for safety; hide any ARGV from perltidy
 210         stderr      => \$stderr_string,
 211         errorfile   => \$errorfile_string,    # not used when -se flag is set
 212     );
 213     if ( $err || $stderr_string || $errorfile_string ) {
 214         print STDERR "Error output received for test '$key'\n";
 215         if ($err) {
 216             print STDERR "An error flag '$err' was returned\n";
 217             ok( !$err );
 218         }
 219         if ($stderr_string) {
 220             print STDERR "---------------------\n";
 221             print STDERR "<<STDERR>>\n$stderr_string\n";
 222             print STDERR "---------------------\n";
 223             ok( !$stderr_string );
 224         }
 225         if ($errorfile_string) {
 226             print STDERR "---------------------\n";
 227             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 228             print STDERR "---------------------\n";
 229             ok( !$errorfile_string );
 230         }
 231     }
 232     else {
 233         if ( !is( $output, $expect, $key ) ) {
 234             my $leno = length($output);
 235             my $lene = length($expect);
 236             if ( $leno == $lene ) {
 237                 print STDERR
 238 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 239             }
 240             else {
 241                 print STDERR
 242 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 243             }
 244         }
 245     }
 246 }