"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/t/snippets10.t" (7 Jan 2020, 27406 Bytes) of package /linux/misc/Perl-Tidy-20200110.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "snippets10.t": 20191203_vs_20200110.

    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 }