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;
  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
 307         'space2' => <<'----------',
 308 # space before this opening paren
 309 for$i(0..20){}
 310
 311 # retain any space between '-' and bare word
 312 $myhash{USER-NAME}='steve';
 313 ----------
 314
 315         'space3' => <<'----------',
 316 # Treat newline as a whitespace. Otherwise, we might combine
 317 # 'Send' and '-recipients' here
 318 my $msg = new Fax::Send
 319      -recipients => $to,
 320      -data => $data;
 321 ----------
 322
 323         'space4' => <<'----------',
 324 # first prototype line will cause space between 'redirect' and '(' to close
 325 sub html::redirect($);        #<-- temporary prototype;
 326 use html;
 327 print html::redirect ('http://www.glob.com.au/');
 328 ----------
 329
 330         'space5' => <<'----------',
 331 # first prototype line commented out; space after 'redirect' remains
 332 #sub html::redirect($);        #<-- temporary prototype;
 333 use html;
 334 print html::redirect ('http://www.glob.com.au/');
 335
 336 ----------
 337
 338         'structure1' => <<'----------',
 339 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?"))));
 340 ----------
 341
 342         'style' => <<'----------',
 343 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 344 sub arrange_topframe {
 345     my(@order) = ($hslabel_frame, $km_frame, $speed_frame[0],
 346                   $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
 347                   @speed_frame[1..$#speed_frame],
 348                   @power_frame[1..$#power_frame],
 349                  );
 350     my(@col)   = (0, 1, 3, 4+$#speed_frame, 5+$#speed_frame+$#power_frame,
 351                   2, 6+$#speed_frame+$#power_frame,
 352                   4..3+$#speed_frame,
 353                   5+$#speed_frame..4+$#speed_frame+$#power_frame);
 354     $top->idletasks;
 355     my $width = 0;
 356     my(%gridslaves) = map {($_, 1)} $top_frame->gridSlaves;
 357     for(my $i = 0; $i <= $#order; $i++) {
 358         my $w = $order[$i];
 359         next unless Tk::Exists($w);
 360         my $col = $col[$i] || 0;
 361         $width += $w->reqwidth;
 362         if ($gridslaves{$w}) {
 363             $w->gridForget;
 364         }
 365         if ($width <= $top->width) {
 366             $w->grid(-row => 0,
 367                      -column => $col,
 368                      -sticky => 'nsew'); # XXX
 369         }
 370     }
 371 }
 372
 373 ----------
 374     };
 375
 376     ####################################
 377     # BEGIN SECTION 3: Expected output #
 378     ####################################
 379     $rtests = {
 380
 381         'scl.def' => {
 382             source => "scl",
 383             params => "def",
 384             expect => <<'#1...........',
 385     # try -scl=12 to see '$returns' joined with the previous line
 386     $format =
 387         "format STDOUT =\n"
 388       . &format_line('Function:       @') . '$name' . "\n"
 389       . &format_line('Arguments:      @') . '$args' . "\n"
 390       . &format_line('Returns:        @')
 391       . '$returns' . "\n"
 392       . &format_line('             ~~ ^') . '$desc' . "\n.\n";
 393 #1...........
 394         },
 395
 396         'scl.scl' => {
 397             source => "scl",
 398             params => "scl",
 399             expect => <<'#2...........',
 400     # try -scl=12 to see '$returns' joined with the previous line
 401     $format =
 402         "format STDOUT =\n"
 403       . &format_line('Function:       @') . '$name' . "\n"
 404       . &format_line('Arguments:      @') . '$args' . "\n"
 405       . &format_line('Returns:        @') . '$returns' . "\n"
 406       . &format_line('             ~~ ^') . '$desc' . "\n.\n";
 407 #2...........
 408         },
 409
 410         'semicolon2.def' => {
 411             source => "semicolon2",
 412             params => "def",
 413             expect => <<'#3...........',
 414         # will not add semicolon for this block type
 415         $highest = List::Util::reduce {
 416             Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b
 417         }
 418 #3...........
 419         },
 420
 421         'side_comments1.def' => {
 422             source => "side_comments1",
 423             params => "def",
 424             expect => <<'#4...........',
 425     # side comments at different indentation levels should not be aligned
 426     {
 427         {
 428             {
 429                 {
 430                     { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
 431                 }    #end level 4
 432             }    # end level 3
 433         }    # end level 2
 434     }    # end level 1
 435 #4...........
 436         },
 437
 438         'sil1.def' => {
 439             source => "sil1",
 440             params => "def",
 441             expect => <<'#5...........',
 442 #############################################################
 443         # This will walk to the left because of bad -sil guess
 444       SKIP: {
 445 #############################################################
 446         }
 447
 448         # This will walk to the right if it is the first line of a file.
 449
 450              ov_method mycan( $package, '(""' ),       $package
 451           or ov_method mycan( $package, '(0+' ),       $package
 452           or ov_method mycan( $package, '(bool' ),     $package
 453           or ov_method mycan( $package, '(nomethod' ), $package;
 454
 455 #5...........
 456         },
 457
 458         'sil1.sil' => {
 459             source => "sil1",
 460             params => "sil",
 461             expect => <<'#6...........',
 462 #############################################################
 463 # This will walk to the left because of bad -sil guess
 464 SKIP: {
 465 #############################################################
 466 }
 467
 468 # This will walk to the right if it is the first line of a file.
 469
 470      ov_method mycan( $package, '(""' ),       $package
 471   or ov_method mycan( $package, '(0+' ),       $package
 472   or ov_method mycan( $package, '(bool' ),     $package
 473   or ov_method mycan( $package, '(nomethod' ), $package;
 474
 475 #6...........
 476         },
 477
 478         'slashslash.def' => {
 479             source => "slashslash",
 480             params => "def",
 481             expect => <<'#7...........',
 482 $home = $ENV{HOME} // $ENV{LOGDIR} // ( getpwuid($<) )[7]
 483   // die "You're homeless!\n";
 484 defined( $x // $y );
 485 $version = 'v' . join '.', map ord, split //, $version->PV;
 486 foreach ( split( //, $lets ) )  { }
 487 foreach ( split( //, $input ) ) { }
 488 'xyz' =~ //;
 489 #7...........
 490         },
 491
 492         'smart.def' => {
 493             source => "smart",
 494             params => "def",
 495             expect => <<'#8...........',
 496 \&foo !~~ \&foo;
 497 \&foo ~~ \&foo;
 498 \&foo ~~ \&foo;
 499 \&foo ~~ sub { };
 500 sub { } ~~ \&foo;
 501 \&foo ~~ \&bar;
 502 \&bar ~~ \&foo;
 503 1 ~~ sub { shift };
 504 sub { shift } ~~ 1;
 505 0 ~~ sub { shift };
 506 sub { shift } ~~ 0;
 507 1 ~~ sub { scalar @_ };
 508 sub { scalar @_ } ~~ 1;
 509 []           ~~ \&bar;
 510 \&bar        ~~ [];
 511 {}           ~~ \&bar;
 512 \&bar        ~~ {};
 513 qr//         ~~ \&bar;
 514 \&bar        ~~ qr//;
 515 a_const      ~~ "a constant";
 516 "a constant" ~~ a_const;
 517 a_const      ~~ a_const;
 518 a_const      ~~ a_const;
 519 a_const      ~~ b_const;
 520 b_const      ~~ a_const;
 521 {}           ~~ {};
 522 {}           ~~ {};
 523 {}           ~~ { 1 => 2 };
 524 { 1 => 2 } ~~ {};
 525 { 1 => 2 } ~~ { 1 => 2 };
 526 { 1 => 2 } ~~ { 1 => 2 };
 527 { 1 => 2 } ~~ { 1 => 3 };
 528 { 1 => 3 } ~~ { 1 => 2 };
 529 { 1 => 2 } ~~ { 2 => 3 };
 530 { 2 => 3 } ~~ { 1 => 2 };
 531 \%main:: ~~ { map { $_ => 'x' } keys %main:: };
 532 {
 533     map { $_ => 'x' } keys %main::
 534 }
 535 ~~ \%main::;
 536 \%hash           ~~ \%tied_hash;
 537 \%tied_hash      ~~ \%hash;
 538 \%tied_hash      ~~ \%tied_hash;
 539 \%tied_hash      ~~ \%tied_hash;
 540 \%::             ~~ [ keys %main:: ];
 541 [ keys %main:: ] ~~ \%::;
 542 \%::             ~~ [];
 543 []               ~~ \%::;
 544 { "" => 1 } ~~ [undef];
 545 [undef] ~~ { "" => 1 };
 546 { foo => 1 } ~~ qr/^(fo[ox])$/;
 547 qr/^(fo[ox])$/ ~~ { foo => 1 };
 548 +{ 0 .. 100 }  ~~ qr/[13579]$/;
 549 qr/[13579]$/   ~~ +{ 0 .. 100 };
 550 +{ foo => 1, bar => 2 } ~~ "foo";
 551 "foo" ~~ +{ foo => 1, bar => 2 };
 552 +{ foo => 1, bar => 2 } ~~ "baz";
 553 "baz" ~~ +{ foo => 1, bar => 2 };
 554 []    ~~ [];
 555 []    ~~ [];
 556 []    ~~ [1];
 557 [1]   ~~ [];
 558 [ ["foo"], ["bar"] ] ~~ [ qr/o/, qr/a/ ];
 559 [ qr/o/, qr/a/ ] ~~ [ ["foo"], ["bar"] ];
 560 [ "foo", "bar" ] ~~ [ qr/o/, qr/a/ ];
 561 [ qr/o/, qr/a/ ] ~~ [ "foo", "bar" ];
 562 $deep1                 ~~ $deep1;
 563 $deep1                 ~~ $deep1;
 564 $deep1                 ~~ $deep2;
 565 $deep2                 ~~ $deep1;
 566 \@nums                 ~~ \@tied_nums;
 567 \@tied_nums            ~~ \@nums;
 568 [qw(foo bar baz quux)] ~~ qr/x/;
 569 qr/x/                  ~~ [qw(foo bar baz quux)];
 570 [qw(foo bar baz quux)] ~~ qr/y/;
 571 qr/y/                  ~~ [qw(foo bar baz quux)];
 572 [qw(1foo 2bar)]        ~~ 2;
 573 2                      ~~ [qw(1foo 2bar)];
 574 [qw(1foo 2bar)]        ~~ "2";
 575 "2"                    ~~ [qw(1foo 2bar)];
 576 2                      ~~ 2;
 577 2                      ~~ 2;
 578 2                      ~~ 3;
 579 3                      ~~ 2;
 580 2                      ~~ "2";
 581 "2"                    ~~ 2;
 582 2                      ~~ "2.0";
 583 "2.0"                  ~~ 2;
 584 2                      ~~ "2bananas";
 585 "2bananas"             ~~ 2;
 586 2_3                    ~~ "2_3";
 587 "2_3"                  ~~ 2_3;
 588 qr/x/                  ~~ "x";
 589 "x"                    ~~ qr/x/;
 590 qr/y/                  ~~ "x";
 591 "x"                    ~~ qr/y/;
 592 12345                  ~~ qr/3/;
 593 qr/3/                  ~~ 12345;
 594 @nums                  ~~ 7;
 595 7                      ~~ @nums;
 596 @nums                  ~~ \@nums;
 597 \@nums                 ~~ @nums;
 598 @nums                  ~~ \\@nums;
 599 \\@nums                ~~ @nums;
 600 @nums                  ~~ [ 1 .. 10 ];
 601 [ 1 .. 10 ]            ~~ @nums;
 602 @nums                  ~~ [ 0 .. 9 ];
 603 [ 0 .. 9 ]             ~~ @nums;
 604 %hash                  ~~ "foo";
 605 "foo"                  ~~ %hash;
 606 %hash                  ~~ /bar/;
 607 /bar/                  ~~ %hash;
 608 #8...........
 609         },
 610
 611         'space1.def' => {
 612             source => "space1",
 613             params => "def",
 614             expect => <<'#9...........',
 615     # We usually want a space at '} (', for example:
 616     map { 1 * $_; } ( $y, $M, $w, $d, $h, $m, $s );
 617
 618     # But not others:
 619     &{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
 620
 621     # remove unwanted spaces after $ and -> here
 622     &{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
 623 #9...........
 624         },
 625
 626         'space2.def' => {
 627             source => "space2",
 628             params => "def",
 629             expect => <<'#10...........',
 630 # space before this opening paren
 631 for $i ( 0 .. 20 ) { }
 632
 633 # retain any space between '-' and bare word
 634 $myhash{ USER-NAME } = 'steve';
 635 #10...........
 636         },
 637
 638         'space3.def' => {
 639             source => "space3",
 640             params => "def",
 641             expect => <<'#11...........',
 642 # Treat newline as a whitespace. Otherwise, we might combine
 643 # 'Send' and '-recipients' here
 644 my $msg = new Fax::Send
 645   -recipients => $to,
 646   -data       => $data;
 647 #11...........
 648         },
 649
 650         'space4.def' => {
 651             source => "space4",
 652             params => "def",
 653             expect => <<'#12...........',
 654 # first prototype line will cause space between 'redirect' and '(' to close
 655 sub html::redirect($);    #<-- temporary prototype;
 656 use html;
 657 print html::redirect('http://www.glob.com.au/');
 658 #12...........
 659         },
 660
 661         'space5.def' => {
 662             source => "space5",
 663             params => "def",
 664             expect => <<'#13...........',
 665 # first prototype line commented out; space after 'redirect' remains
 666 #sub html::redirect($);        #<-- temporary prototype;
 667 use html;
 668 print html::redirect ('http://www.glob.com.au/');
 669
 670 #13...........
 671         },
 672
 673         'structure1.def' => {
 674             source => "structure1",
 675             params => "def",
 676             expect => <<'#14...........',
 677 push @contents,
 678   $c->table(
 679     { -width => '100%' },
 680     $c->Tr(
 681         $c->td(
 682             { -align => 'left' },
 683             "The emboldened field names are mandatory, ",
 684             "the remainder are optional",
 685         ),
 686         $c->td(
 687             { -align => 'right' },
 688             $c->a(
 689                 { -href => 'help.cgi', -target => '_blank' },
 690                 "What are the various fields?"
 691             )
 692         )
 693     )
 694   );
 695 #14...........
 696         },
 697
 698         'style.def' => {
 699             source => "style",
 700             params => "def",
 701             expect => <<'#15...........',
 702 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 703 sub arrange_topframe {
 704     my (@order) = (
 705         $hslabel_frame,
 706         $km_frame,
 707         $speed_frame[0],
 708         $power_frame[0],
 709         $wind_frame,
 710         $percent_frame,
 711         $temp_frame,
 712         @speed_frame[ 1 .. $#speed_frame ],
 713         @power_frame[ 1 .. $#power_frame ],
 714     );
 715     my (@col) = (
 716         0,
 717         1,
 718         3,
 719         4 + $#speed_frame,
 720         5 + $#speed_frame + $#power_frame,
 721         2,
 722         6 + $#speed_frame + $#power_frame,
 723         4 .. 3 + $#speed_frame,
 724         5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 725     );
 726     $top->idletasks;
 727     my $width = 0;
 728     my (%gridslaves) = map { ( $_, 1 ) } $top_frame->gridSlaves;
 729     for ( my $i = 0 ; $i <= $#order ; $i++ ) {
 730         my $w = $order[$i];
 731         next unless Tk::Exists($w);
 732         my $col = $col[$i] || 0;
 733         $width += $w->reqwidth;
 734         if ( $gridslaves{$w} ) {
 735             $w->gridForget;
 736         }
 737         if ( $width <= $top->width ) {
 738             $w->grid(
 739                 -row    => 0,
 740                 -column => $col,
 741                 -sticky => 'nsew'
 742             );    # XXX
 743         }
 744     }
 745 }
 746
 747 #15...........
 748         },
 749
 750         'style.style1' => {
 751             source => "style",
 752             params => "style1",
 753             expect => <<'#16...........',
 754 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 755 sub arrange_topframe {
 756   my (@order) = (
 757     $hslabel_frame, $km_frame, $speed_frame[0],
 758     $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
 759     @speed_frame[1 .. $#speed_frame],
 760     @power_frame[1 .. $#power_frame],
 761   );
 762   my (@col) = (
 763     0, 1, 3,
 764     4 + $#speed_frame,
 765     5 + $#speed_frame + $#power_frame,
 766     2,
 767     6 + $#speed_frame + $#power_frame,
 768     4 .. 3 + $#speed_frame,
 769     5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 770   );
 771   $top->idletasks;
 772   my $width = 0;
 773   my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 774   for (my $i = 0; $i <= $#order; $i++) {
 775     my $w = $order[$i];
 776     next unless Tk::Exists($w);
 777     my $col = $col[$i] || 0;
 778     $width += $w->reqwidth;
 779     if ($gridslaves{$w}) {
 780       $w->gridForget;
 781     }
 782     if ($width <= $top->width) {
 783       $w->grid(
 784         -row    => 0,
 785         -column => $col,
 786         -sticky => 'nsew'
 787       );    # XXX
 788     }
 789   }
 790 }
 791
 792 #16...........
 793         },
 794
 795         'style.style2' => {
 796             source => "style",
 797             params => "style2",
 798             expect => <<'#17...........',
 799 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 800 sub arrange_topframe {
 801     my (@order) = (
 802         $hslabel_frame,  $km_frame,
 803         $speed_frame[0], $power_frame[0],
 804         $wind_frame,     $percent_frame,
 805         $temp_frame,     @speed_frame[1..$#speed_frame],
 806         @power_frame[1..$#power_frame],
 807     );
 808     my (@col) = (
 809         0,
 810         1,
 811         3,
 812         4 + $#speed_frame,
 813         5 + $#speed_frame + $#power_frame,
 814         2,
 815         6 + $#speed_frame + $#power_frame,
 816         4..3 + $#speed_frame,
 817         5 + $#speed_frame..4 + $#speed_frame + $#power_frame
 818     );
 819     $top->idletasks;
 820     my $width = 0;
 821     my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 822     for (my $i = 0; $i <= $#order; $i++) {
 823         my $w = $order[$i];
 824         next unless Tk::Exists($w);
 825         my $col = $col[$i] || 0;
 826         $width += $w->reqwidth;
 827         if ($gridslaves{$w}) {
 828             $w->gridForget;
 829         }
 830         if ($width <= $top->width) {
 831             $w->grid(
 832                 -row    => 0,
 833                 -column => $col,
 834                 -sticky => 'nsew'
 835             );    # XXX
 836         }
 837     }
 838 }
 839
 840 #17...........
 841         },
 842
 843         'style.style3' => {
 844             source => "style",
 845             params => "style3",
 846             expect => <<'#18...........',
 847 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 848 sub arrange_topframe {
 849     my (@order) = (
 850                     $hslabel_frame, $km_frame, $speed_frame[0], $power_frame[0], $wind_frame, $percent_frame, $temp_frame,
 851                     @speed_frame[ 1 .. $#speed_frame ],
 852                     @power_frame[ 1 .. $#power_frame ],
 853                   );
 854     my (@col) = (
 855                   0, 1, 3,
 856                   4 + $#speed_frame,
 857                   5 + $#speed_frame + $#power_frame,
 858                   2,
 859                   6 + $#speed_frame + $#power_frame,
 860                   4 .. 3 + $#speed_frame,
 861                   5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 862                 );
 863     $top->idletasks;
 864     my $width = 0;
 865     my (%gridslaves) = map { ( $_, 1 ) } $top_frame->gridSlaves;
 866     for ( my $i = 0 ; $i <= $#order ; $i++ ) {
 867         my $w = $order[$i];
 868         next unless Tk::Exists($w);
 869         my $col = $col[$i] || 0;
 870         $width += $w->reqwidth;
 871         if ( $gridslaves{$w} ) {
 872             $w->gridForget;
 873         }
 874         if ( $width <= $top->width ) {
 875             $w->grid(
 876                       -row    => 0,
 877                       -column => $col,
 878                       -sticky => 'nsew'
 879                     );    # XXX
 880         }
 881     }
 882 } ## end sub arrange_topframe
 883
 884 #18...........
 885         },
 886
 887         'style.style4' => {
 888             source => "style",
 889             params => "style4",
 890             expect => <<'#19...........',
 891 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 892 sub arrange_topframe {
 893     my (@order) = (
 894         $hslabel_frame,  $km_frame,
 895         $speed_frame[0], $power_frame[0],
 896         $wind_frame,     $percent_frame,
 897         $temp_frame,     @speed_frame[1 .. $#speed_frame],
 898         @power_frame[1 .. $#power_frame],
 899     );
 900     my (@col) = (
 901         0,
 902         1,
 903         3,
 904         4 + $#speed_frame,
 905         5 + $#speed_frame + $#power_frame,
 906         2,
 907         6 + $#speed_frame + $#power_frame,
 908         4 .. 3 + $#speed_frame,
 909         5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 910     );
 911     $top->idletasks;
 912     my $width = 0;
 913     my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 914     for (my $i = 0 ; $i <= $#order ; $i++) {
 915         my $w = $order[$i];
 916         next unless Tk::Exists($w);
 917         my $col = $col[$i] || 0;
 918         $width += $w->reqwidth;
 919         if ($gridslaves{$w}) {
 920             $w->gridForget;
 921         }
 922         if ($width <= $top->width) {
 923             $w->grid(
 924                 -row    => 0,
 925                 -column => $col,
 926                 -sticky => 'nsew'
 927             );    # XXX
 928         }
 929     }
 930 }
 931
 932 #19...........
 933         },
 934
 935         'style.style5' => {
 936             source => "style",
 937             params => "style5",
 938             expect => <<'#20...........',
 939 # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
 940 sub arrange_topframe
 941 {
 942     my (@order) = (
 943         $hslabel_frame,  $km_frame,
 944         $speed_frame[0], $power_frame[0],
 945         $wind_frame,     $percent_frame,
 946         $temp_frame,     @speed_frame[1 .. $#speed_frame],
 947         @power_frame[1 .. $#power_frame],
 948         );
 949     my (@col) = (
 950         0,
 951         1,
 952         3,
 953         4 + $#speed_frame,
 954         5 + $#speed_frame + $#power_frame,
 955         2,
 956         6 + $#speed_frame + $#power_frame,
 957         4 .. 3 + $#speed_frame,
 958         5 + $#speed_frame .. 4 + $#speed_frame + $#power_frame
 959         );
 960     $top->idletasks;
 961     my $width = 0;
 962     my (%gridslaves) = map { ($_, 1) } $top_frame->gridSlaves;
 963     for (my $i = 0; $i <= $#order; $i++)
 964     {
 965         my $w = $order[$i];
 966         next unless Tk::Exists($w);
 967         my $col = $col[$i] || 0;
 968         $width += $w->reqwidth;
 969         if ($gridslaves{$w})
 970         {
 971             $w->gridForget;
 972         }
 973         if ($width <= $top->width)
 974         {
 975             $w->grid(
 976                 -row    => 0,
 977                 -column => $col,
 978                 -sticky => 'nsew'
 979                 );  # XXX
 980         }
 981     }
 982 }
 983
 984 #20...........
 985         },
 986     };
 987
 988     my $ntests = 0 + keys %{$rtests};
 989     plan tests => $ntests;
 990 }
 991
 992 ###############
 993 # EXECUTE TESTS
 994 ###############
 995
 996 foreach my $key ( sort keys %{$rtests} ) {
 997     my $output;
 998     my $sname  = $rtests->{$key}->{source};
 999     my $expect = $rtests->{$key}->{expect};
1000     my $pname  = $rtests->{$key}->{params};
1001     my $source = $rsources->{$sname};
1002     my $params = defined($pname) ? $rparams->{$pname} : "";
1003     my $stderr_string;
1004     my $errorfile_string;
1005     my $err = Perl::Tidy::perltidy(
1006         source      => \$source,
1007         destination => \$output,
1008         perltidyrc  => \$params,
1009         argv        => '',             # for safety; hide any ARGV from perltidy
1010         stderr      => \$stderr_string,
1011         errorfile => \$errorfile_string,    # not used when -se flag is set
1012     );
1013     if ( $err || $stderr_string || $errorfile_string ) {
1014         if ($err) {
1015             print STDERR
1016 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
1017             ok( !$err );
1018         }
1019         if ($stderr_string) {
1020             print STDERR "---------------------\n";
1021             print STDERR "<<STDERR>>\n$stderr_string\n";
1022             print STDERR "---------------------\n";
1023             print STDERR
1024 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
1025             ok( !$stderr_string );
1026         }
1027         if ($errorfile_string) {
1028             print STDERR "---------------------\n";
1029             print STDERR "<<.ERR file>>\n$errorfile_string\n";
1030             print STDERR "---------------------\n";
1031             print STDERR
1032 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
1033             ok( !$errorfile_string );
1034         }
1035     }
1036     else {
1037         ok( $output, $expect );
1038     }
1039 }