t/snippets10.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 scl.def
   5 #2 scl.scl
   6 #3 semicolon2.def
   7 #4 side_comments1.def
   8 #5 sil1.def
   9 #6 sil1.sil
  10 #7 slashslash.def
  11 #8 smart.def
  12 #9 space1.def
  13 #10 space2.def
  14 #11 space3.def
  15 #12 space4.def
  16 #13 space5.def
  17 #14 structure1.def
  18 #15 style.def
  19 #16 style.style1
  20 #17 style.style2
  21 #18 style.style3
  22 #19 style.style4
  23 #20 style.style5
  24
  25 # To locate test #13 you can search for its name or the string '#13'
  26
  27 use strict;
  28 use Test::More;
  29 use Carp;
  30 use Perl::Tidy;
  31 my $rparams;
  32 my $rsources;
  33 my $rtests;
  34
  35 BEGIN {
  36
  37     ###########################################
  38     # BEGIN SECTION 1: Parameter combinations #
  39     ###########################################
  40     $rparams = {
  41         'def'    => "",
  42         'scl'    => "-scl=12",
  43         'sil'    => "-sil=0",
  44         'style1' => <<'----------',
  45 -b
  46 -se
  47 -w
  48 -i=2
  49 -l=100
  50 -nolq
  51 -bbt=1
  52 -bt=2
  53 -pt=2
  54 -nsfs
  55 -sbt=2
  56 -sbvt=2
  57 -nhsc
  58 -isbc
  59 -bvt=2
  60 -pvt=2
  61 -wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
  62 -mbl=2
  63 ----------
  64         'style2' => <<'----------',
  65 -bt=2
  66 -nwls=".."
  67 -nwrs=".."
  68 -pt=2
  69 -nsfs
  70 -sbt=2
  71 -cuddled-blocks
  72 -bar
  73 -nsbl
  74 -nbbc
  75 ----------
  76         'style3' => <<'----------',
  77 -l=160
  78 -cbi=1
  79 -cpi=1
  80 -csbi=1
  81 -lp
  82 -nolq
  83 -csci=20
  84 -csct=40
  85 -csc
  86 -isbc
  87 -cuddled-blocks
  88 -nsbl
  89 -dcsc
  90 ----------
  91         'style4' => <<'----------',
  92 -bt=2
  93 -pt=2
  94 -sbt=2
  95 -cuddled-blocks
  96 -bar
  97 ----------
  98         'style5' => <<'----------',
  99 -b
 100 -bext="~"
 101 -et=8
 102 -l=77
 103 -cbi=2
 104 -cpi=2
 105 -csbi=2
 106 -ci=4
 107 -nolq
 108 -nasc
 109 -bt=2
 110 -ndsm
 111 -nwls="++ -- ?"
 112 -nwrs="++ --"
 113 -pt=2
 114 -nsfs
 115 -nsts
 116 -sbt=2
 117 -sbvt=1
 118 -wls="= .= =~ !~ :"
 119 -wrs="= .= =~ !~ ? :"
 120 -ncsc
 121 -isbc
 122 -msc=2
 123 -nolc
 124 -bvt=1
 125 -bl
 126 -sbl
 127 -pvt=1
 128 -wba="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x= . << >> -> && ||"
 129 -wbb=" "
 130 -cab=1
 131 -mbl=2
 132 ----------
 133     };
 134
 135     ############################
 136     # BEGIN SECTION 2: Sources #
 137     ############################
 138     $rsources = {
 139
 140         'scl' => <<'----------',
 141     # try -scl=12 to see '$returns' joined with the previous line
 142     $format = "format STDOUT =\n" . &format_line('Function:       @') . '$name' . "\n" . &format_line('Arguments:      @') . '$args' . "\n" . &format_line('Returns:        @') . '$returns' . "\n" . &format_line('             ~~ ^') . '$desc' . "\n.\n";
 143 ----------
 144
 145         'semicolon2' => <<'----------',
 146         # will not add semicolon for this block type
 147         $highest = List::Util::reduce { Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b }
 148 ----------
 149
 150         'side_comments1' => <<'----------',
 151     # side comments at different indentation levels should not be aligned
 152     { { { { { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } } #end level 4
 153             } # end level 3
 154         } # end level 2
 155     } # end level 1
 156 ----------
 157
 158         'sil1' => <<'----------',
 159 #############################################################
 160         # This will walk to the left because of bad -sil guess
 161       SKIP: {
 162 #############################################################
 163         }
 164
 165 # This will walk to the right if it is the first line of a file.
 166
 167      ov_method mycan( $package, '(""' ),       $package
 168   or ov_method mycan( $package, '(0+' ),       $package
 169   or ov_method mycan( $package, '(bool' ),     $package
 170   or ov_method mycan( $package, '(nomethod' ), $package;
 171
 172 ----------
 173
 174         'slashslash' => <<'----------',
 175 $home = $ENV{HOME} // $ENV{LOGDIR} // ( getpwuid($<) )[7]
 176   // die "You're homeless!\n";
 177 defined( $x // $y );
 178 $version = 'v' . join '.', map ord, split //, $version->PV;
 179 foreach ( split( //, $lets ) )  { }
 180 foreach ( split( //, $input ) ) { }
 181 'xyz' =~ //;
 182 ----------
 183
 184         'smart' => <<'----------',
 185 \&foo !~~ \&foo;
 186 \&foo ~~ \&foo;
 187 \&foo ~~ \&foo;
 188 \&foo ~~ sub {};
 189 sub {} ~~ \&foo;
 190 \&foo ~~ \&bar;
 191 \&bar ~~ \&foo;
 192 1 ~~ sub{shift};
 193 sub{shift} ~~ 1;
 194 0 ~~ sub{shift};
 195 sub{shift} ~~ 0;
 196 1 ~~ sub{scalar @_};
 197 sub{scalar @_} ~~ 1;
 198 [] ~~ \&bar;
 199 \&bar ~~ [];
 200 {} ~~ \&bar;
 201 \&bar ~~ {};
 202 qr// ~~ \&bar;
 203 \&bar ~~ qr//;
 204 a_const ~~ "a constant";
 205 "a constant" ~~ a_const;
 206 a_const ~~ a_const;
 207 a_const ~~ a_const;
 208 a_const ~~ b_const;
 209 b_const ~~ a_const;
 210 {} ~~ {};
 211 {} ~~ {};
 212 {} ~~ {1 => 2};
 213 {1 => 2} ~~ {};
 214 {1 => 2} ~~ {1 => 2};
 215 {1 => 2} ~~ {1 => 2};
 216 {1 => 2} ~~ {1 => 3};
 217 {1 => 3} ~~ {1 => 2};
 218 {1 => 2} ~~ {2 => 3};
 219 {2 => 3} ~~ {1 => 2};
 220 \%main:: ~~ {map {$_ => 'x'} keys %main::};
 221 {map {$_ => 'x'} keys %main::} ~~ \%main::;
 222 \%hash ~~ \%tied_hash;
 223 \%tied_hash ~~ \%hash;
 224 \%tied_hash ~~ \%tied_hash;
 225 \%tied_hash ~~ \%tied_hash;
 226 \%:: ~~ [keys %main::];
 227 [keys %main::] ~~ \%::;
 228 \%:: ~~ [];
 229 [] ~~ \%::;
 230 {"" => 1} ~~ [undef];
 231 [undef] ~~ {"" => 1};
 232 {foo => 1} ~~ qr/^(fo[ox])$/;
 233 qr/^(fo[ox])$/ ~~ {foo => 1};
 234 +{0..100} ~~ qr/[13579]$/;
 235 qr/[13579]$/ ~~ +{0..100};
 236 +{foo => 1, bar => 2} ~~ "foo";
 237 "foo" ~~ +{foo => 1, bar => 2};
 238 +{foo => 1, bar => 2} ~~ "baz";
 239 "baz" ~~ +{foo => 1, bar => 2};
 240 [] ~~ [];
 241 [] ~~ [];
 242 [] ~~ [1];
 243 [1] ~~ [];
 244 [["foo"], ["bar"]] ~~ [qr/o/, qr/a/];
 245 [qr/o/, qr/a/] ~~ [["foo"], ["bar"]];
 246 ["foo", "bar"] ~~ [qr/o/, qr/a/];
 247 [qr/o/, qr/a/] ~~ ["foo", "bar"];
 248 $deep1 ~~ $deep1;
 249 $deep1 ~~ $deep1;
 250 $deep1 ~~ $deep2;
 251 $deep2 ~~ $deep1;
 252 \@nums ~~ \@tied_nums;
 253 \@tied_nums ~~ \@nums;
 254 [qw(foo bar baz quux)] ~~ qr/x/;
 255 qr/x/ ~~ [qw(foo bar baz quux)];
 256 [qw(foo bar baz quux)] ~~ qr/y/;
 257 qr/y/ ~~ [qw(foo bar baz quux)];
 258 [qw(1foo 2bar)] ~~ 2;
 259 2 ~~ [qw(1foo 2bar)];
 260 [qw(1foo 2bar)] ~~ "2";
 261 "2" ~~ [qw(1foo 2bar)];
 262 2 ~~ 2;
 263 2 ~~ 2;
 264 2 ~~ 3;
 265 3 ~~ 2;
 266 2 ~~ "2";
 267 "2" ~~ 2;
 268 2 ~~ "2.0";
 269 "2.0" ~~ 2;
 270 2 ~~ "2bananas";
 271 "2bananas" ~~ 2;
 272 2_3 ~~ "2_3";
 273 "2_3" ~~ 2_3;
 274 qr/x/ ~~ "x";
 275 "x" ~~ qr/x/;
 276 qr/y/ ~~ "x";
 277 "x" ~~ qr/y/;
 278 12345 ~~ qr/3/;
 279 qr/3/ ~~ 12345;
 280 @nums ~~ 7;
 281 7 ~~ @nums;
 282 @nums ~~ \@nums;
 283 \@nums ~~ @nums;
 284 @nums ~~ \\@nums;
 285 \\@nums ~~ @nums;
 286 @nums ~~ [1..10];
 287 [1..10] ~~ @nums;
 288 @nums ~~ [0..9];
 289 [0..9] ~~ @nums;
 290 %hash ~~ "foo";
 291 "foo" ~~ %hash;
 292 %hash ~~ /bar/;
 293 /bar/ ~~ %hash;
 294 ----------
 295
 296         'space1' => <<'----------',
 297     # We usually want a space at '} (', for example:
 298     map { 1 * $_; } ( $y, $M, $w, $d, $h, $m, $s );
 299
 300     # But not others:
 301     &{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
 302
 303     # remove unwanted spaces after $ and -> here
 304     &{ $ _ -> [1] }( delete $ _ [$#_   ]{ $_   ->     [0] } );
 305
 306     # this has both tabs and spaces to remove
 307     $    setup = $       labels ->       labelsetup( Output_Width       => 2.625) ;
 308 ----------
 309
 310         'space2' => <<'----------',
 311 # space before this opening paren
 312 for$i(0..20){}
 313
 314 # retain any space between '-' and bare word
 315 $myhash{USER-NAME}='steve';
 316 ----------
 317
 318         'space3' => <<'----------',
 319 # Treat newline as a whitespace. Otherwise, we might combine
 320 # 'Send' and '-recipients' here
 321 my $msg = new Fax::Send
 322      -recipients => $to,
 323      -data => $data;
 324 ----------
 325
 326         'space4' => <<'----------',
 327 # first prototype line will cause space between 'redirect' and '(' to close
 328 sub html::redirect($);        #<-- temporary prototype;
 329 use html;
 330 print html::redirect ('http://www.glob.com.au/');
 331 ----------
 332
 333         'space5' => <<'----------',
 334 # first prototype line commented out; space after 'redirect' remains
 335 #sub html::redirect($);        #<-- temporary prototype;
 336 use html;
 337 print html::redirect ('http://www.glob.com.au/');
 338
 339 ----------
 340
 341         'structure1' => <<'----------',
 342 push@contents,$c->table({-width=>'100%'},$c->Tr($c->td({-align=>'left'},"The emboldened field names are mandatory, ","the remainder are optional",),$c->td({-align=>'right'},$c->a({-href=>'help.cgi',-target=>'_blank'},"What are the various fields?"))));
 343 ----------
 344
 345         'style' => <<'----------',
 346 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 347 sub arrange_topframe {
 348     my(@order) = ($hslabel_frame, $km_frame, $speed_frame[0],
 349                   $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
 350                   @speed_frame[1..$#speed_frame],
 351                   @power_frame[1..$#power_frame],
 352                  );
 353     my(@col)   = (0, 1, 3, 4+$#speed_frame, 5+$#speed_frame+$#power_frame,
 354                   2, 6+$#speed_frame+$#power_frame,
 355                   4..3+$#speed_frame,
 356                   5+$#speed_frame..4+$#speed_frame+$#power_frame);
 357     $top->idletasks;
 358     my $width = 0;
 359     my(%gridslaves) = map {($_, 1)} $top_frame->gridSlaves;
 360     for(my $i = 0; $i <= $#order; $i++) {
 361         my $w = $order[$i];
 362         next unless Tk::Exists($w);
 363         my $col = $col[$i] || 0;
 364         $width += $w->reqwidth;
 365         if ($gridslaves{$w}) {
 366             $w->gridForget;
 367         }
 368         if ($width <= $top->width) {
 369             $w->grid(-row => 0,
 370                      -column => $col,
 371                      -sticky => 'nsew'); # XXX
 372         }
 373     }
 374 }
 375
 376 ----------
 377     };
 378
 379     ####################################
 380     # BEGIN SECTION 3: Expected output #
 381     ####################################
 382     $rtests = {
 383
 384         'scl.def' => {
 385             source => "scl",
 386             params => "def",
 387             expect => <<'#1...........',
 388     # try -scl=12 to see '$returns' joined with the previous line
 389     $format =
 390         "format STDOUT =\n"
 391       . &format_line('Function:       @') . '$name' . "\n"
 392       . &format_line('Arguments:      @') . '$args' . "\n"
 393       . &format_line('Returns:        @')
 394       . '$returns' . "\n"
 395       . &format_line('             ~~ ^') . '$desc' . "\n.\n";
 396 #1...........
 397         },
 398
 399         'scl.scl' => {
 400             source => "scl",
 401             params => "scl",
 402             expect => <<'#2...........',
 403     # try -scl=12 to see '$returns' joined with the previous line
 404     $format =
 405         "format STDOUT =\n"
 406       . &format_line('Function:       @') . '$name' . "\n"
 407       . &format_line('Arguments:      @') . '$args' . "\n"
 408       . &format_line('Returns:        @') . '$returns' . "\n"
 409       . &format_line('             ~~ ^') . '$desc' . "\n.\n";
 410 #2...........
 411         },
 412
 413         'semicolon2.def' => {
 414             source => "semicolon2",
 415             params => "def",
 416             expect => <<'#3...........',
 417         # will not add semicolon for this block type
 418         $highest = List::Util::reduce {
 419             Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b
 420         }
 421 #3...........
 422         },
 423
 424         'side_comments1.def' => {
 425             source => "side_comments1",
 426             params => "def",
 427             expect => <<'#4...........',
 428     # side comments at different indentation levels should not be aligned
 429     {
 430         {
 431             {
 432                 {
 433                     { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
 434                 }    #end level 4
 435             }    # end level 3
 436         }    # end level 2
 437     }    # end level 1
 438 #4...........
 439         },
 440
 441         'sil1.def' => {
 442             source => "sil1",
 443             params => "def",
 444             expect => <<'#5...........',
 445 #############################################################
 446         # This will walk to the left because of bad -sil guess
 447       SKIP: {
 448 #############################################################
 449         }
 450
 451         # This will walk to the right if it is the first line of a file.
 452
 453              ov_method mycan( $package, '(""' ),       $package
 454           or ov_method mycan( $package, '(0+' ),       $package
 455           or ov_method mycan( $package, '(bool' ),     $package
 456           or ov_method mycan( $package, '(nomethod' ), $package;
 457
 458 #5...........
 459         },
 460
 461         'sil1.sil' => {
 462             source => "sil1",
 463             params => "sil",
 464             expect => <<'#6...........',
 465 #############################################################
 466 # This will walk to the left because of bad -sil guess
 467 SKIP: {
 468 #############################################################
 469 }
 470
 471 # This will walk to the right if it is the first line of a file.
 472
 473      ov_method mycan( $package, '(""' ),       $package
 474   or ov_method mycan( $package, '(0+' ),       $package
 475   or ov_method mycan( $package, '(bool' ),     $package
 476   or ov_method mycan( $package, '(nomethod' ), $package;
 477
 478 #6...........
 479         },
 480
 481         'slashslash.def' => {
 482             source => "slashslash",
 483             params => "def",
 484             expect => <<'#7...........',
 485 $home = $ENV{HOME} // $ENV{LOGDIR} // ( getpwuid($<) )[7]
 486   // die "You're homeless!\n";
 487 defined( $x // $y );
 488 $version = 'v' . join '.', map ord, split //, $version->PV;
 489 foreach ( split( //, $lets ) )  { }
 490 foreach ( split( //, $input ) ) { }
 491 'xyz' =~ //;
 492 #7...........
 493         },
 494
 495         'smart.def' => {
 496             source => "smart",
 497             params => "def",
 498             expect => <<'#8...........',
 499 \&foo !~~ \&foo;
 500 \&foo             ~~ \&foo;
 501 \&foo             ~~ \&foo;
 502 \&foo             ~~ sub { };
 503 sub { }           ~~ \&foo;
 504 \&foo             ~~ \&bar;
 505 \&bar             ~~ \&foo;
 506 1                 ~~ sub { shift };
 507 sub { shift }     ~~ 1;
 508 0                 ~~ sub { shift };
 509 sub { shift }     ~~ 0;
 510 1                 ~~ sub { scalar @_ };
 511 sub { scalar @_ } ~~ 1;
 512 []                ~~ \&bar;
 513 \&bar             ~~ [];
 514 {}                ~~ \&bar;
 515 \&bar             ~~ {};
 516 qr//              ~~ \&bar;
 517 \&bar             ~~ qr//;
 518 a_const           ~~ "a constant";
 519 "a constant"      ~~ a_const;
 520 a_const           ~~ a_const;
 521 a_const           ~~ a_const;
 522 a_const           ~~ b_const;
 523 b_const           ~~ a_const;
 524 {}                ~~ {};
 525 {}                ~~ {};
 526 {}                ~~ { 1 => 2 };
 527 { 1 => 2 }        ~~ {};
 528 { 1 => 2 } ~~ { 1 => 2 };
 529 { 1 => 2 } ~~ { 1 => 2 };
 530 { 1 => 2 } ~~ { 1 => 3 };
 531 { 1 => 3 } ~~ { 1 => 2 };
 532 { 1 => 2 } ~~ { 2 => 3 };
 533 { 2 => 3 } ~~ { 1 => 2 };
 534 \%main:: ~~ { map { $_ => 'x' } keys %main:: };
 535 {
 536     map { $_ => 'x' } keys %main::
 537 }
 538 ~~ \%main::;
 539 \%hash                  ~~ \%tied_hash;
 540 \%tied_hash             ~~ \%hash;
 541 \%tied_hash             ~~ \%tied_hash;
 542 \%tied_hash             ~~ \%tied_hash;
 543 \%::                    ~~ [ keys %main:: ];
 544 [ keys %main:: ]        ~~ \%::;
 545 \%::                    ~~ [];
 546 []                      ~~ \%::;
 547 { "" => 1 }             ~~ [undef];
 548 [undef]                 ~~ { "" => 1 };
 549 { foo => 1 }            ~~ qr/^(fo[ox])$/;
 550 qr/^(fo[ox])$/          ~~ { foo => 1 };
 551 +{ 0 .. 100 }           ~~ qr/[13579]$/;
 552 qr/[13579]$/            ~~ +{ 0 .. 100 };
 553 +{ foo => 1, bar => 2 } ~~ "foo";
 554 "foo"                   ~~ +{ foo => 1, bar => 2 };
 555 +{ foo => 1, bar => 2 } ~~ "baz";
 556 "baz"                   ~~ +{ foo => 1, bar => 2 };
 557 []                      ~~ [];
 558 []                      ~~ [];
 559 []                      ~~ [1];
 560 [1]                     ~~ [];
 561 [ ["foo"], ["bar"] ]    ~~ [ qr/o/, qr/a/ ];
 562 [ qr/o/, qr/a/ ]        ~~ [ ["foo"], ["bar"] ];
 563 [ "foo", "bar" ]        ~~ [ qr/o/, qr/a/ ];
 564 [ qr/o/, qr/a/ ]        ~~ [ "foo", "bar" ];
 565 $deep1                  ~~ $deep1;
 566 $deep1                  ~~ $deep1;
 567 $deep1                  ~~ $deep2;
 568 $deep2                  ~~ $deep1;
 569 \@nums                  ~~ \@tied_nums;
 570 \@tied_nums             ~~ \@nums;
 571 [qw(foo bar baz quux)]  ~~ qr/x/;
 572 qr/x/                   ~~ [qw(foo bar baz quux)];
 573 [qw(foo bar baz quux)]  ~~ qr/y/;
 574 qr/y/                   ~~ [qw(foo bar baz quux)];
 575 [qw(1foo 2bar)]         ~~ 2;
 576 2                       ~~ [qw(1foo 2bar)];
 577 [qw(1foo 2bar)]         ~~ "2";
 578 "2"                     ~~ [qw(1foo 2bar)];
 579 2                       ~~ 2;
 580 2                       ~~ 2;
 581 2                       ~~ 3;
 582 3                       ~~ 2;
 583 2                       ~~ "2";
 584 "2"                     ~~ 2;
 585 2                       ~~ "2.0";
 586 "2.0"                   ~~ 2;
 587 2                       ~~ "2bananas";
 588 "2bananas"              ~~ 2;
 589 2_3                     ~~ "2_3";
 590 "2_3"                   ~~ 2_3;
 591 qr/x/                   ~~ "x";
 592 "x"                     ~~ qr/x/;
 593 qr/y/                   ~~ "x";
 594 "x"                     ~~ qr/y/;
 595 12345                   ~~ qr/3/;
 596 qr/3/                   ~~ 12345;
 597 @nums                   ~~ 7;
 598 7                       ~~ @nums;
 599 @nums                   ~~ \@nums;
 600 \@nums                  ~~ @nums;
 601 @nums                   ~~ \\@nums;
 602 \\@nums                 ~~ @nums;
 603 @nums                   ~~ [ 1 .. 10 ];
 604 [ 1 .. 10 ]             ~~ @nums;
 605 @nums                   ~~ [ 0 .. 9 ];
 606 [ 0 .. 9 ]              ~~ @nums;
 607 %hash                   ~~ "foo";
 608 "foo"                   ~~ %hash;
 609 %hash                   ~~ /bar/;
 610 /bar/                   ~~ %hash;
 611 #8...........
 612         },
 613
 614         'space1.def' => {
 615             source => "space1",
 616             params => "def",
 617             expect => <<'#9...........',
 618     # We usually want a space at '} (', for example:
 619     map { 1 * $_; } ( $y, $M, $w, $d, $h, $m, $s );
 620
 621     # But not others:
 622     &{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
 623
 624     # remove unwanted spaces after $ and -> here
 625     &{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
 626
 627     # this has both tabs and spaces to remove
 628     $setup = $labels->labelsetup( Output_Width => 2.625 );
 629 #9...........
 630         },
 631
 632         'space2.def' => {
 633             source => "space2",
 634             params => "def",
 635             expect => <<'#10...........',
 636 # space before this opening paren
 637 for $i ( 0 .. 20 ) { }
 638
 639 # retain any space between '-' and bare word
 640 $myhash{ USER-NAME } = 'steve';
 641 #10...........
 642         },
 643
 644         'space3.def' => {
 645             source => "space3",
 646             params => "def",
 647             expect => <<'#11...........',
 648 # Treat newline as a whitespace. Otherwise, we might combine
 649 # 'Send' and '-recipients' here
 650 my $msg = new Fax::Send
 651   -recipients => $to,
 652   -data       => $data;
 653 #11...........
 654         },
 655
 656         'space4.def' => {
 657             source => "space4",
 658             params => "def",
 659             expect => <<'#12...........',
 660 # first prototype line will cause space between 'redirect' and '(' to close
 661 sub html::redirect($);    #<-- temporary prototype;
 662 use html;
 663 print html::redirect('http://www.glob.com.au/');
 664 #12...........
 665         },
 666
 667         'space5.def' => {
 668             source => "space5",
 669             params => "def",
 670             expect => <<'#13...........',
 671 # first prototype line commented out; space after 'redirect' remains
 672 #sub html::redirect($);        #<-- temporary prototype;
 673 use html;
 674 print html::redirect ('http://www.glob.com.au/');
 675
 676 #13...........
 677         },
 678
 679         'structure1.def' => {
 680             source => "structure1",
 681             params => "def",
 682             expect => <<'#14...........',
 683 push @contents,
 684   $c->table(
 685     { -width => '100%' },
 686     $c->Tr(
 687         $c->td(
 688             { -align => 'left' },
 689             "The emboldened field names are mandatory, ",
 690             "the remainder are optional",
 691         ),
 692         $c->td(
 693             { -align => 'right' },
 694             $c->a(
 695                 { -href => 'help.cgi', -target => '_blank' },
 696                 "What are the various fields?"
 697             )
 698         )
 699     )
 700   );
 701 #14...........
 702         },
 703
 704         'style.def' => {
 705             source => "style",
 706             params => "def",
 707             expect => <<'#15...........',
 708 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 709 sub arrange_topframe {
 710     my (@order) = (
 711         $hslabel_frame,
 712         $km_frame,
 713         $speed_frame[0],
 714         $power_frame[0],
 715         $wind_frame,
 716         $percent_frame,
 717         $temp_frame,
 718         @speed_frame[ 1 .. $#speed_frame ],
 719         @power_frame[ 1 .. $#power_frame ],
 720     );
 721     my (@col) = (
 722         0,
 723         1,
 724         3,
 725         4 + $#speed_frame,
 726         5 + $#speed_frame + $#power_frame,
 727         2,
 728         6 + $#speed_frame + $#power_frame,
 729         4 .. 3 + $#speed_frame,
 730         5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 731     );
 732     $top->idletasks;
 733     my $width = 0;
 734     my (%gridslaves) = map { ( $_, 1 ) } $top_frame->gridSlaves;
 735     for ( my $i = 0 ; $i <= $#order ; $i++ ) {
 736         my $w = $order[$i];
 737         next unless Tk::Exists($w);
 738         my $col = $col[$i] || 0;
 739         $width += $w->reqwidth;
 740         if ( $gridslaves{$w} ) {
 741             $w->gridForget;
 742         }
 743         if ( $width <= $top->width ) {
 744             $w->grid(
 745                 -row    => 0,
 746                 -column => $col,
 747                 -sticky => 'nsew'
 748             );    # XXX
 749         }
 750     }
 751 }
 752
 753 #15...........
 754         },
 755
 756         'style.style1' => {
 757             source => "style",
 758             params => "style1",
 759             expect => <<'#16...........',
 760 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 761 sub arrange_topframe {
 762   my (@order) = (
 763     $hslabel_frame,  $km_frame,   $speed_frame[0],
 764     $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
 765     @speed_frame[1 .. $#speed_frame],
 766     @power_frame[1 .. $#power_frame],
 767   );
 768   my (@col) = (
 769     0, 1, 3,
 770     4 + $#speed_frame,
 771     5 + $#speed_frame + $#power_frame,
 772     2,
 773     6 + $#speed_frame + $#power_frame,
 774     4 .. 3 + $#speed_frame,
 775     5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 776   );
 777   $top->idletasks;
 778   my $width = 0;
 779   my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 780   for (my $i = 0; $i <= $#order; $i++) {
 781     my $w = $order[$i];
 782     next unless Tk::Exists($w);
 783     my $col = $col[$i] || 0;
 784     $width += $w->reqwidth;
 785     if ($gridslaves{$w}) {
 786       $w->gridForget;
 787     }
 788     if ($width <= $top->width) {
 789       $w->grid(
 790         -row    => 0,
 791         -column => $col,
 792         -sticky => 'nsew'
 793       );    # XXX
 794     }
 795   }
 796 }
 797
 798 #16...........
 799         },
 800
 801         'style.style2' => {
 802             source => "style",
 803             params => "style2",
 804             expect => <<'#17...........',
 805 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 806 sub arrange_topframe {
 807     my (@order) = (
 808         $hslabel_frame,  $km_frame,
 809         $speed_frame[0], $power_frame[0],
 810         $wind_frame,     $percent_frame,
 811         $temp_frame,     @speed_frame[1..$#speed_frame],
 812         @power_frame[1..$#power_frame],
 813     );
 814     my (@col) = (
 815         0,
 816         1,
 817         3,
 818         4 + $#speed_frame,
 819         5 + $#speed_frame + $#power_frame,
 820         2,
 821         6 + $#speed_frame + $#power_frame,
 822         4..3 + $#speed_frame,
 823         5 + $#speed_frame..4 + $#speed_frame + $#power_frame
 824     );
 825     $top->idletasks;
 826     my $width = 0;
 827     my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 828     for (my $i = 0; $i <= $#order; $i++) {
 829         my $w = $order[$i];
 830         next unless Tk::Exists($w);
 831         my $col = $col[$i] || 0;
 832         $width += $w->reqwidth;
 833         if ($gridslaves{$w}) {
 834             $w->gridForget;
 835         }
 836         if ($width <= $top->width) {
 837             $w->grid(
 838                 -row    => 0,
 839                 -column => $col,
 840                 -sticky => 'nsew'
 841             );    # XXX
 842         }
 843     }
 844 }
 845
 846 #17...........
 847         },
 848
 849         'style.style3' => {
 850             source => "style",
 851             params => "style3",
 852             expect => <<'#18...........',
 853 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 854 sub arrange_topframe {
 855     my (@order) = (
 856                     $hslabel_frame, $km_frame, $speed_frame[0], $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
 857                     @speed_frame[ 1 .. $#speed_frame ],
 858                     @power_frame[ 1 .. $#power_frame ],
 859                   );
 860     my (@col) = (
 861                   0, 1, 3,
 862                   4 + $#speed_frame,
 863                   5 + $#speed_frame + $#power_frame,
 864                   2,
 865                   6 + $#speed_frame + $#power_frame,
 866                   4 .. 3 + $#speed_frame,
 867                   5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 868                 );
 869     $top->idletasks;
 870     my $width = 0;
 871     my (%gridslaves) = map { ( $_, 1 ) } $top_frame->gridSlaves;
 872     for ( my $i = 0 ; $i <= $#order ; $i++ ) {
 873         my $w = $order[$i];
 874         next unless Tk::Exists($w);
 875         my $col = $col[$i] || 0;
 876         $width += $w->reqwidth;
 877         if ( $gridslaves{$w} ) {
 878             $w->gridForget;
 879         }
 880         if ( $width <= $top->width ) {
 881             $w->grid(
 882                       -row    => 0,
 883                       -column => $col,
 884                       -sticky => 'nsew'
 885                     );    # XXX
 886         }
 887     }
 888 } ## end sub arrange_topframe
 889
 890 #18...........
 891         },
 892
 893         'style.style4' => {
 894             source => "style",
 895             params => "style4",
 896             expect => <<'#19...........',
 897 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 898 sub arrange_topframe {
 899     my (@order) = (
 900         $hslabel_frame,  $km_frame,
 901         $speed_frame[0], $power_frame[0],
 902         $wind_frame,     $percent_frame,
 903         $temp_frame,     @speed_frame[1 .. $#speed_frame],
 904         @power_frame[1 .. $#power_frame],
 905     );
 906     my (@col) = (
 907         0,
 908         1,
 909         3,
 910         4 + $#speed_frame,
 911         5 + $#speed_frame + $#power_frame,
 912         2,
 913         6 + $#speed_frame + $#power_frame,
 914         4 .. 3 + $#speed_frame,
 915         5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 916     );
 917     $top->idletasks;
 918     my $width = 0;
 919     my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 920     for (my $i = 0 ; $i <= $#order ; $i++) {
 921         my $w = $order[$i];
 922         next unless Tk::Exists($w);
 923         my $col = $col[$i] || 0;
 924         $width += $w->reqwidth;
 925         if ($gridslaves{$w}) {
 926             $w->gridForget;
 927         }
 928         if ($width <= $top->width) {
 929             $w->grid(
 930                 -row    => 0,
 931                 -column => $col,
 932                 -sticky => 'nsew'
 933             );    # XXX
 934         }
 935     }
 936 }
 937
 938 #19...........
 939         },
 940
 941         'style.style5' => {
 942             source => "style",
 943             params => "style5",
 944             expect => <<'#20...........',
 945 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 946 sub arrange_topframe
 947 {
 948     my (@order) = (
 949         $hslabel_frame,  $km_frame,
 950         $speed_frame[0], $power_frame[0],
 951         $wind_frame,     $percent_frame,
 952         $temp_frame,     @speed_frame[1 .. $#speed_frame],
 953         @power_frame[1 .. $#power_frame],
 954         );
 955     my (@col) = (
 956         0,
 957         1,
 958         3,
 959         4 + $#speed_frame,
 960         5 + $#speed_frame + $#power_frame,
 961         2,
 962         6 + $#speed_frame + $#power_frame,
 963         4 .. 3 + $#speed_frame,
 964         5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 965         );
 966     $top->idletasks;
 967     my $width = 0;
 968     my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 969     for (my $i = 0; $i <= $#order; $i++)
 970     {
 971         my $w = $order[$i];
 972         next unless Tk::Exists($w);
 973         my $col = $col[$i] || 0;
 974         $width += $w->reqwidth;
 975         if ($gridslaves{$w})
 976         {
 977             $w->gridForget;
 978         }
 979         if ($width <= $top->width)
 980         {
 981             $w->grid(
 982                 -row    => 0,
 983                 -column => $col,
 984                 -sticky => 'nsew'
 985                 );  # XXX
 986         }
 987     }
 988 }
 989
 990 #20...........
 991         },
 992     };
 993
 994     my $ntests = 0 + keys %{$rtests};
 995     plan tests => $ntests;
 996 }
 997
 998 ###############
 999 # EXECUTE TESTS
1000 ###############
1001
1002 foreach my $key ( sort keys %{$rtests} ) {
1003     my $output;
1004     my $sname  = $rtests->{$key}->{source};
1005     my $expect = $rtests->{$key}->{expect};
1006     my $pname  = $rtests->{$key}->{params};
1007     my $source = $rsources->{$sname};
1008     my $params = defined($pname) ? $rparams->{$pname} : "";
1009     my $stderr_string;
1010     my $errorfile_string;
1011     my $err = Perl::Tidy::perltidy(
1012         source      => \$source,
1013         destination => \$output,
1014         perltidyrc  => \$params,
1015         argv        => '',             # for safety; hide any ARGV from perltidy
1016         stderr      => \$stderr_string,
1017         errorfile   => \$errorfile_string,    # not used when -se flag is set
1018     );
1019     if ( $err || $stderr_string || $errorfile_string ) {
1020         print STDERR "Error output received for test '$key'\n";
1021         if ($err) {
1022             print STDERR "An error flag '$err' was returned\n";
1023             ok( !$err );
1024         }
1025         if ($stderr_string) {
1026             print STDERR "---------------------\n";
1027             print STDERR "<<STDERR>>\n$stderr_string\n";
1028             print STDERR "---------------------\n";
1029             ok( !$stderr_string );
1030         }
1031         if ($errorfile_string) {
1032             print STDERR "---------------------\n";
1033             print STDERR "<<.ERR file>>\n$errorfile_string\n";
1034             print STDERR "---------------------\n";
1035             ok( !$errorfile_string );
1036         }
1037     }
1038     else {
1039         if ( !is( $output, $expect, $key ) ) {
1040             my $leno = length($output);
1041             my $lene = length($expect);
1042             if ( $leno == $lene ) {
1043                 print STDERR
1044 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
1045             }
1046             else {
1047                 print STDERR
1048 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
1049             }
1050         }
1051     }
1052 }