t/snippets5.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 list1.def
   5 #2 listop1.def
   6 #3 listop2.def
   7 #4 lp1.def
   8 #5 lp1.lp
   9 #6 mangle1.def
  10 #7 mangle1.mangle
  11 #8 mangle2.def
  12 #9 mangle2.mangle
  13 #10 mangle3.def
  14 #11 mangle3.mangle
  15 #12 math1.def
  16 #13 math2.def
  17 #14 math3.def
  18 #15 math4.def
  19 #16 nasc.def
  20 #17 nasc.nasc
  21 #18 nothing.def
  22 #19 nothing.nothing
  23 #20 otr1.def
  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         'lp'      => "-lp",
  43         'mangle'  => "--mangle",
  44         'nasc'    => "-nasc",
  45         'nothing' => "",
  46     };
  47
  48     ############################
  49     # BEGIN SECTION 2: Sources #
  50     ############################
  51     $rsources = {
  52
  53         'list1' => <<'----------',
  54 %height=("letter",27.9, "legal",35.6, "arche",121.9, "archd",91.4, "archc",61,
  55  "archb",45.7, "archa",30.5, "flsa",33, "flse",33, "halfletter",21.6,
  56  "11x17",43.2, "ledger",27.9);
  57 %width=("letter",21.6, "legal",21.6, "arche",91.4, "archd",61, "archc",45.7,
  58  "archb",30.5, "archa",22.9, "flsa",21.6, "flse",21.6, "halfletter",14,
  59  "11x17",27.9, "ledger",43.2);
  60 ----------
  61
  62         'listop1' => <<'----------',
  63 my @sorted = map { $_->[0] }
  64   sort { $a->[1] <=> $b->[1] }
  65   map { [ $_, rand ] } @list;
  66 ----------
  67
  68         'listop2' => <<'----------',
  69 my @sorted =
  70   map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, rand ] } @list;
  71 ----------
  72
  73         'lp1' => <<'----------',
  74 # a good test problem for -lp; thanks to Ian Stuart
  75 push @contents,
  76   $c->table(
  77  { -border => '1' },
  78  $c->Tr(
  79   { -valign => 'top' },
  80   $c->td(
  81    " Author ",
  82    $c->textfield(
  83     -tabindex => "1",
  84     -name => "author",
  85     -default => "$author",
  86     -size => '20'
  87    )
  88   ),
  89   $c->td(
  90    $c->strong(" Publication Date "),
  91    $c->textfield(
  92     -tabindex => "2",
  93     -name => "pub_date",
  94     -default => "$pub_date",
  95     -size => '20'
  96    ),
  97   )
  98  ),
  99  $c->Tr(
 100   { -valign => 'top' },
 101   $c->td(
 102    { -colspan => '2' },
 103    $c->strong("Title"),
 104    $c->textfield(
 105     -tabindex => "3",
 106     -name => "title",
 107     -default => "$title",
 108     -override => '1',
 109     -size => '40'
 110    ),
 111   )
 112  ),
 113  $c->Tr(
 114   { -valign => 'top' },
 115   $c->td(
 116    $c->table(
 117     $c->Tr(
 118      $c->td( { -valign => 'top' }, $c->strong(" Document Type ") ),
 119      $c->td(
 120       { -valign => 'top' },
 121       $c->scrolling_list(
 122        -tabindex => "4",
 123        -name => "doc_type",
 124        -values => [@docCodeValues],
 125        -labels => \%docCodeLabels,
 126        -default => "$doc_type"
 127       )
 128      )
 129     )
 130    )
 131   ),
 132   $c->td(
 133    $c->table(
 134     $c->Tr(
 135      $c->td(
 136       { -valign => 'top' },
 137       $c->strong( " Relevant Discipline ", $c->br(), "Area " )
 138      ),
 139      $c->td(
 140       { -valign => 'top' },
 141       $c->scrolling_list(
 142        -tabindex => "5",
 143        -name => "discipline",
 144        -values => [@discipValues],
 145        -labels => \%discipLabels,
 146        -default => "$discipline"
 147       ),
 148      )
 149     )
 150    )
 151   )
 152  ),
 153  $c->Tr(
 154   { -valign => 'top' },
 155   $c->td(
 156    { -colspan => '2' },
 157    $c->table(
 158     $c->Tr(
 159      $c->td(
 160       { -valign => 'top' }, $c->strong(" Relevant Subject Area "),
 161       $c->br(), "You may select multiple areas",
 162      ),
 163      $c->td(
 164       { -valign => 'top' },
 165       $c->checkbox_group(
 166        -tabindex => "6",
 167        -name => "subject",
 168        -values => [@subjValues],
 169        -labels => \%subjLabels,
 170        -defaults => [@subject],
 171        -rows => "2"
 172       )
 173      )
 174     )
 175    )
 176   )
 177  ),
 178  $c->Tr(
 179   { -valign => 'top' },
 180   $c->td(
 181    { -colspan => '2' },
 182    $c->strong("Location<BR>"),
 183    $c->small("(ie, where to find it)"),
 184    $c->textfield(
 185     -tabindex => "7",
 186     -name => "location",
 187     -default => "$location",
 188     -size => '40'
 189    )
 190   )
 191  ),
 192  $c->Tr(
 193   { -valign => 'top' },
 194   $c->td(
 195    { -colspan => '2' },
 196    $c->table(
 197     $c->Tr(
 198      $c->td(
 199       { -valign => 'top' }, "Description",
 200       $c->br(), $c->small("Maximum 750 letters.")
 201      ),
 202      $c->td(
 203       { -valign => 'top' },
 204       $c->textarea(
 205        -tabindex => "8",
 206        -name => "description",
 207        -default => "$description",
 208        -wrap => "soft",
 209        -rows => '10',
 210        -columns => '60'
 211       )
 212      )
 213     )
 214    )
 215   )
 216  ),
 217   );
 218 ----------
 219
 220         'mangle1' => <<'----------',
 221 # The space after the '?' is essential and must not be deleted
 222 print $::opt_m ? "  Files:  ".my_wrap("","          ",$v) : $v;
 223 ----------
 224
 225         'mangle2' => <<'----------',
 226 # hanging side comments - do not remove leading space with -mangle
 227 if ( $size1 == 0 || $size2 == 0 ) {    # special handling for zero-length
 228     if ( $size2 + $size1 == 0 ) {      # files.
 229         exit 0;
 230     }
 231     else {                             # Can't we say 'differ at byte zero'
 232                                        # and so on here?  That might make
 233                                        # more sense than this behavior.
 234                                        # Also, this should be made consistent
 235                                        # with the behavior when skip >=
 236                                        # filesize.
 237         if ($volume) {
 238             warn "$0: EOF on $file1\n" unless $size1;
 239             warn "$0: EOF on $file2\n" unless $size2;
 240         }
 241         exit 1;
 242     }
 243 }
 244
 245 ----------
 246
 247         'mangle3' => <<'----------',
 248 # run with --mangle
 249 # Troublesome punctuation variables: $$ and $#
 250
 251 # don't delete ws between '$$' and 'if'
 252 kill 'ABRT', $$ if $panic++;
 253
 254 # Do not remove the space between '$#' and 'eq'
 255 $, = "Hello, World!\n";
 256 $#=$,;
 257 print "$# ";
 258 $# eq $,? print "yes\n" : print "no\n";
 259
 260 # The space after the '?' is essential and must not be deleted
 261 print $::opt_m ? "  Files:  ".my_wrap("","          ",$v) : $v;
 262
 263 # must not remove space before 'CAKE'
 264 use constant CAKE => atan2(1,1)/2;
 265 if ($arc >= - CAKE && $arc <= CAKE) {
 266 }
 267
 268 # do not remove the space after 'JUNK':
 269 print JUNK ("<","&",">")[rand(3)];# make these a bit more likely
 270 ----------
 271
 272         'math1' => <<'----------',
 273 my $xyz_shield = [ [ -0.060,  -0.060,  0. ],
 274                    [ 0.060,   -0.060,  0. ],
 275                    [ 0.060,   0.060,   0. ],
 276                    [ -0.060,  0.060,   0. ],
 277                    [ -0.0925, -0.0925, 0.092 ],
 278                    [ 0.0925,  -0.0925, 0.092 ],
 279                    [ 0.0925,  0.0925,  0.092 ],
 280                    [ -0.0925, 0.0925,  0.092 ], ];
 281 ----------
 282
 283         'math2' => <<'----------',
 284 $ans = pdl(
 285            [0, 0, 0, 0, 0],
 286            [0, 0, 2, 0, 0],
 287            [0, 1, 5, 2, 0],
 288            [0, 0, 4, 0, 0],
 289            [0, 0, 0, 0, 0]
 290            );
 291 ----------
 292
 293         'math3' => <<'----------',
 294     my ( $x, $y ) = ( $x0 + $index_x * $xgridwidth * $xm + ( $map_x * $xm * $xgridwidth ) / $detailwidth, $y0 - $index_y * $ygridwidth * $ym - ( $map_y * $ym * $ygridwidth ) / $detailheight,);
 295 ----------
 296
 297         'math4' => <<'----------',
 298 my$u=($range*$pratio**(1./3.))/$wratio;
 299 my$factor=exp(-(18/$u)**4);
 300 my$ovp=(1-$factor)*(70-0.655515*$u)+(1000/($u**1.3)+10000/($u**3.3))*$factor;
 301 my$impulse=(1-$factor)*(170-$u)+(350/$u**0.65+500/$u**5)*$factor;
 302 $ovp=$ovp*$pratio;
 303 $impulse=$impulse*$wratio*$pratio**(2/3);
 304 ----------
 305
 306         'nasc' => <<'----------',
 307         # will break and add semicolon unless -nasc is given
 308         eval { $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed } };
 309 ----------
 310
 311         'nothing' => <<'----------',
 312 ----------
 313
 314         'otr1' => <<'----------',
 315 return $pdl->slice(
 316     join ',',
 317     (
 318         map {
 319                 $_ eq "X" ? ":"
 320               : ref $_ eq "ARRAY" ? join ':', @$_
 321               : !ref $_ ? $_
 322               : die "INVALID SLICE DEF $_"
 323         } @_
 324     )
 325 );
 326 ----------
 327     };
 328
 329     ####################################
 330     # BEGIN SECTION 3: Expected output #
 331     ####################################
 332     $rtests = {
 333
 334         'list1.def' => {
 335             source => "list1",
 336             params => "def",
 337             expect => <<'#1...........',
 338 %height = (
 339     "letter",     27.9, "legal", 35.6, "arche",  121.9,
 340     "archd",      91.4, "archc", 61,   "archb",  45.7,
 341     "archa",      30.5, "flsa",  33,   "flse",   33,
 342     "halfletter", 21.6, "11x17", 43.2, "ledger", 27.9
 343 );
 344 %width = (
 345     "letter",     21.6, "legal", 21.6, "arche",  91.4,
 346     "archd",      61,   "archc", 45.7, "archb",  30.5,
 347     "archa",      22.9, "flsa",  21.6, "flse",   21.6,
 348     "halfletter", 14,   "11x17", 27.9, "ledger", 43.2
 349 );
 350 #1...........
 351         },
 352
 353         'listop1.def' => {
 354             source => "listop1",
 355             params => "def",
 356             expect => <<'#2...........',
 357 my @sorted = map { $_->[0] }
 358   sort { $a->[1] <=> $b->[1] }
 359   map { [ $_, rand ] } @list;
 360 #2...........
 361         },
 362
 363         'listop2.def' => {
 364             source => "listop2",
 365             params => "def",
 366             expect => <<'#3...........',
 367 my @sorted =
 368   map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, rand ] } @list;
 369 #3...........
 370         },
 371
 372         'lp1.def' => {
 373             source => "lp1",
 374             params => "def",
 375             expect => <<'#4...........',
 376 # a good test problem for -lp; thanks to Ian Stuart
 377 push @contents,
 378   $c->table(
 379     { -border => '1' },
 380     $c->Tr(
 381         { -valign => 'top' },
 382         $c->td(
 383             " Author ",
 384             $c->textfield(
 385                 -tabindex => "1",
 386                 -name     => "author",
 387                 -default  => "$author",
 388                 -size     => '20'
 389             )
 390         ),
 391         $c->td(
 392             $c->strong(" Publication Date "),
 393             $c->textfield(
 394                 -tabindex => "2",
 395                 -name     => "pub_date",
 396                 -default  => "$pub_date",
 397                 -size     => '20'
 398             ),
 399         )
 400     ),
 401     $c->Tr(
 402         { -valign => 'top' },
 403         $c->td(
 404             { -colspan => '2' },
 405             $c->strong("Title"),
 406             $c->textfield(
 407                 -tabindex => "3",
 408                 -name     => "title",
 409                 -default  => "$title",
 410                 -override => '1',
 411                 -size     => '40'
 412             ),
 413         )
 414     ),
 415     $c->Tr(
 416         { -valign => 'top' },
 417         $c->td(
 418             $c->table(
 419                 $c->Tr(
 420                     $c->td(
 421                         { -valign => 'top' },
 422                         $c->strong(" Document Type ")
 423                     ),
 424                     $c->td(
 425                         { -valign => 'top' },
 426                         $c->scrolling_list(
 427                             -tabindex => "4",
 428                             -name     => "doc_type",
 429                             -values   => [@docCodeValues],
 430                             -labels   => \%docCodeLabels,
 431                             -default  => "$doc_type"
 432                         )
 433                     )
 434                 )
 435             )
 436         ),
 437         $c->td(
 438             $c->table(
 439                 $c->Tr(
 440                     $c->td(
 441                         { -valign => 'top' },
 442                         $c->strong(
 443                             " Relevant Discipline ", $c->br(), "Area "
 444                         )
 445                     ),
 446                     $c->td(
 447                         { -valign => 'top' },
 448                         $c->scrolling_list(
 449                             -tabindex => "5",
 450                             -name     => "discipline",
 451                             -values   => [@discipValues],
 452                             -labels   => \%discipLabels,
 453                             -default  => "$discipline"
 454                         ),
 455                     )
 456                 )
 457             )
 458         )
 459     ),
 460     $c->Tr(
 461         { -valign => 'top' },
 462         $c->td(
 463             { -colspan => '2' },
 464             $c->table(
 465                 $c->Tr(
 466                     $c->td(
 467                         { -valign => 'top' },
 468                         $c->strong(" Relevant Subject Area "),
 469                         $c->br(),
 470                         "You may select multiple areas",
 471                     ),
 472                     $c->td(
 473                         { -valign => 'top' },
 474                         $c->checkbox_group(
 475                             -tabindex => "6",
 476                             -name     => "subject",
 477                             -values   => [@subjValues],
 478                             -labels   => \%subjLabels,
 479                             -defaults => [@subject],
 480                             -rows     => "2"
 481                         )
 482                     )
 483                 )
 484             )
 485         )
 486     ),
 487     $c->Tr(
 488         { -valign => 'top' },
 489         $c->td(
 490             { -colspan => '2' },
 491             $c->strong("Location<BR>"),
 492             $c->small("(ie, where to find it)"),
 493             $c->textfield(
 494                 -tabindex => "7",
 495                 -name     => "location",
 496                 -default  => "$location",
 497                 -size     => '40'
 498             )
 499         )
 500     ),
 501     $c->Tr(
 502         { -valign => 'top' },
 503         $c->td(
 504             { -colspan => '2' },
 505             $c->table(
 506                 $c->Tr(
 507                     $c->td(
 508                         { -valign => 'top' },
 509                         "Description", $c->br(),
 510                         $c->small("Maximum 750 letters.")
 511                     ),
 512                     $c->td(
 513                         { -valign => 'top' },
 514                         $c->textarea(
 515                             -tabindex => "8",
 516                             -name     => "description",
 517                             -default  => "$description",
 518                             -wrap     => "soft",
 519                             -rows     => '10',
 520                             -columns  => '60'
 521                         )
 522                     )
 523                 )
 524             )
 525         )
 526     ),
 527   );
 528 #4...........
 529         },
 530
 531         'lp1.lp' => {
 532             source => "lp1",
 533             params => "lp",
 534             expect => <<'#5...........',
 535 # a good test problem for -lp; thanks to Ian Stuart
 536 push @contents,
 537   $c->table(
 538              { -border => '1' },
 539              $c->Tr(
 540                      { -valign => 'top' },
 541                      $c->td(
 542                              " Author ",
 543                              $c->textfield(
 544                                             -tabindex => "1",
 545                                             -name     => "author",
 546                                             -default  => "$author",
 547                                             -size     => '20'
 548                              )
 549                      ),
 550                      $c->td(
 551                              $c->strong(" Publication Date "),
 552                              $c->textfield(
 553                                             -tabindex => "2",
 554                                             -name     => "pub_date",
 555                                             -default  => "$pub_date",
 556                                             -size     => '20'
 557                              ),
 558                      )
 559              ),
 560              $c->Tr(
 561                      { -valign => 'top' },
 562                      $c->td(
 563                              { -colspan => '2' },
 564                              $c->strong("Title"),
 565                              $c->textfield(
 566                                             -tabindex => "3",
 567                                             -name     => "title",
 568                                             -default  => "$title",
 569                                             -override => '1',
 570                                             -size     => '40'
 571                              ),
 572                      )
 573              ),
 574              $c->Tr(
 575                      { -valign => 'top' },
 576                      $c->td(
 577                              $c->table(
 578                                         $c->Tr(
 579                                             $c->td(
 580                                                    { -valign => 'top' },
 581                                                    $c->strong(" Document Type ")
 582                                             ),
 583                                             $c->td(
 584                                                 { -valign => 'top' },
 585                                                 $c->scrolling_list(
 586                                                     -tabindex => "4",
 587                                                     -name     => "doc_type",
 588                                                     -values => [@docCodeValues],
 589                                                     -labels => \%docCodeLabels,
 590                                                     -default => "$doc_type"
 591                                                 )
 592                                             )
 593                                         )
 594                              )
 595                      ),
 596                      $c->td(
 597                              $c->table(
 598                                         $c->Tr(
 599                                              $c->td(
 600                                                     { -valign => 'top' },
 601                                                     $c->strong(
 602                                                         " Relevant Discipline ",
 603                                                         $c->br(),
 604                                                         "Area "
 605                                                     )
 606                                              ),
 607                                              $c->td(
 608                                                  { -valign => 'top' },
 609                                                  $c->scrolling_list(
 610                                                      -tabindex => "5",
 611                                                      -name     => "discipline",
 612                                                      -values => [@discipValues],
 613                                                      -labels => \%discipLabels,
 614                                                      -default => "$discipline"
 615                                                  ),
 616                                              )
 617                                         )
 618                              )
 619                      )
 620              ),
 621              $c->Tr(
 622                      { -valign => 'top' },
 623                      $c->td(
 624                              { -colspan => '2' },
 625                              $c->table(
 626                                   $c->Tr(
 627                                       $c->td(
 628                                           { -valign => 'top' },
 629                                           $c->strong(" Relevant Subject Area "),
 630                                           $c->br(),
 631                                           "You may select multiple areas",
 632                                       ),
 633                                       $c->td(
 634                                               { -valign => 'top' },
 635                                               $c->checkbox_group(
 636                                                        -tabindex => "6",
 637                                                        -name     => "subject",
 638                                                        -values => [@subjValues],
 639                                                        -labels => \%subjLabels,
 640                                                        -defaults => [@subject],
 641                                                        -rows     => "2"
 642                                               )
 643                                       )
 644                                   )
 645                              )
 646                      )
 647              ),
 648              $c->Tr(
 649                      { -valign => 'top' },
 650                      $c->td(
 651                              { -colspan => '2' },
 652                              $c->strong("Location<BR>"),
 653                              $c->small("(ie, where to find it)"),
 654                              $c->textfield(
 655                                             -tabindex => "7",
 656                                             -name     => "location",
 657                                             -default  => "$location",
 658                                             -size     => '40'
 659                              )
 660                      )
 661              ),
 662              $c->Tr(
 663                      { -valign => 'top' },
 664                      $c->td(
 665                              { -colspan => '2' },
 666                              $c->table(
 667                                        $c->Tr(
 668                                            $c->td(
 669                                                { -valign => 'top' },
 670                                                "Description",
 671                                                $c->br(),
 672                                                $c->small("Maximum 750 letters.")
 673                                            ),
 674                                            $c->td(
 675                                                  { -valign => 'top' },
 676                                                  $c->textarea(
 677                                                      -tabindex => "8",
 678                                                      -name     => "description",
 679                                                      -default => "$description",
 680                                                      -wrap    => "soft",
 681                                                      -rows    => '10',
 682                                                      -columns => '60'
 683                                                  )
 684                                            )
 685                                        )
 686                              )
 687                      )
 688              ),
 689   );
 690 #5...........
 691         },
 692
 693         'mangle1.def' => {
 694             source => "mangle1",
 695             params => "def",
 696             expect => <<'#6...........',
 697 # The space after the '?' is essential and must not be deleted
 698 print $::opt_m ? "  Files:  " . my_wrap( "", "          ", $v ) : $v;
 699 #6...........
 700         },
 701
 702         'mangle1.mangle' => {
 703             source => "mangle1",
 704             params => "mangle",
 705             expect => <<'#7...........',
 706 # The space after the '?' is essential and must not be deleted
 707 print$::opt_m ? "  Files:  ".my_wrap("","          ",$v):$v;
 708 #7...........
 709         },
 710
 711         'mangle2.def' => {
 712             source => "mangle2",
 713             params => "def",
 714             expect => <<'#8...........',
 715 # hanging side comments - do not remove leading space with -mangle
 716 if ( $size1 == 0 || $size2 == 0 ) {    # special handling for zero-length
 717     if ( $size2 + $size1 == 0 ) {      # files.
 718         exit 0;
 719     }
 720     else {                             # Can't we say 'differ at byte zero'
 721                                        # and so on here?  That might make
 722                                        # more sense than this behavior.
 723                                        # Also, this should be made consistent
 724                                        # with the behavior when skip >=
 725                                        # filesize.
 726         if ($volume) {
 727             warn "$0: EOF on $file1\n" unless $size1;
 728             warn "$0: EOF on $file2\n" unless $size2;
 729         }
 730         exit 1;
 731     }
 732 }
 733
 734 #8...........
 735         },
 736
 737         'mangle2.mangle' => {
 738             source => "mangle2",
 739             params => "mangle",
 740             expect => <<'#9...........',
 741 # hanging side comments - do not remove leading space with -mangle
 742 if($size1==0||$size2==0){# special handling for zero-length
 743 if($size2+$size1==0){# files.
 744 exit 0;}else{# Can't we say 'differ at byte zero'
 745  # and so on here?  That might make
 746  # more sense than this behavior.
 747  # Also, this should be made consistent
 748  # with the behavior when skip >=
 749  # filesize.
 750 if($volume){warn"$0: EOF on $file1\n" unless$size1;
 751 warn"$0: EOF on $file2\n" unless$size2;}exit 1;}}
 752 #9...........
 753         },
 754
 755         'mangle3.def' => {
 756             source => "mangle3",
 757             params => "def",
 758             expect => <<'#10...........',
 759 # run with --mangle
 760 # Troublesome punctuation variables: $$ and $#
 761
 762 # don't delete ws between '$$' and 'if'
 763 kill 'ABRT', $$ if $panic++;
 764
 765 # Do not remove the space between '$#' and 'eq'
 766 $, = "Hello, World!\n";
 767 $# = $,;
 768 print "$# ";
 769 $# eq $, ? print "yes\n" : print "no\n";
 770
 771 # The space after the '?' is essential and must not be deleted
 772 print $::opt_m ? "  Files:  " . my_wrap( "", "          ", $v ) : $v;
 773
 774 # must not remove space before 'CAKE'
 775 use constant CAKE => atan2( 1, 1 ) / 2;
 776 if ( $arc >= - CAKE && $arc <= CAKE ) {
 777 }
 778
 779 # do not remove the space after 'JUNK':
 780 print JUNK ( "<", "&", ">" )[ rand(3) ];    # make these a bit more likely
 781 #10...........
 782         },
 783
 784         'mangle3.mangle' => {
 785             source => "mangle3",
 786             params => "mangle",
 787             expect => <<'#11...........',
 788 # run with --mangle
 789 # Troublesome punctuation variables: $$ and $#
 790 # don't delete ws between '$$' and 'if'
 791 kill 'ABRT',$$ if$panic++;
 792 # Do not remove the space between '$#' and 'eq'
 793 $,="Hello, World!\n";
 794 $#=$,;
 795 print"$# ";
 796 $# eq$,?print"yes\n":print"no\n";
 797 # The space after the '?' is essential and must not be deleted
 798 print$::opt_m ? "  Files:  ".my_wrap("","          ",$v):$v;
 799 # must not remove space before 'CAKE'
 800 use constant CAKE=>atan2(1,1)/2;
 801 if($arc>=- CAKE&&$arc<=CAKE){}
 802 # do not remove the space after 'JUNK':
 803 print JUNK ("<","&",">")[rand(3)];# make these a bit more likely
 804 #11...........
 805         },
 806
 807         'math1.def' => {
 808             source => "math1",
 809             params => "def",
 810             expect => <<'#12...........',
 811 my $xyz_shield = [
 812     [ -0.060,  -0.060,  0. ],
 813     [ 0.060,   -0.060,  0. ],
 814     [ 0.060,   0.060,   0. ],
 815     [ -0.060,  0.060,   0. ],
 816     [ -0.0925, -0.0925, 0.092 ],
 817     [ 0.0925,  -0.0925, 0.092 ],
 818     [ 0.0925,  0.0925,  0.092 ],
 819     [ -0.0925, 0.0925,  0.092 ],
 820 ];
 821 #12...........
 822         },
 823
 824         'math2.def' => {
 825             source => "math2",
 826             params => "def",
 827             expect => <<'#13...........',
 828 $ans = pdl(
 829     [ 0, 0, 0, 0, 0 ],
 830     [ 0, 0, 2, 0, 0 ],
 831     [ 0, 1, 5, 2, 0 ],
 832     [ 0, 0, 4, 0, 0 ],
 833     [ 0, 0, 0, 0, 0 ]
 834 );
 835 #13...........
 836         },
 837
 838         'math3.def' => {
 839             source => "math3",
 840             params => "def",
 841             expect => <<'#14...........',
 842     my ( $x, $y ) = (
 843         $x0 +
 844           $index_x * $xgridwidth * $xm +
 845           ( $map_x * $xm * $xgridwidth ) / $detailwidth,
 846         $y0 -
 847           $index_y * $ygridwidth * $ym -
 848           ( $map_y * $ym * $ygridwidth ) / $detailheight,
 849     );
 850 #14...........
 851         },
 852
 853         'math4.def' => {
 854             source => "math4",
 855             params => "def",
 856             expect => <<'#15...........',
 857 my $u      = ( $range * $pratio**( 1. / 3. ) ) / $wratio;
 858 my $factor = exp( -( 18 / $u )**4 );
 859 my $ovp    = ( 1 - $factor ) * ( 70 - 0.655515 * $u ) +
 860   ( 1000 / ( $u**1.3 ) + 10000 / ( $u**3.3 ) ) * $factor;
 861 my $impulse =
 862   ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
 863 $ovp     = $ovp * $pratio;
 864 $impulse = $impulse * $wratio * $pratio**( 2 / 3 );
 865 #15...........
 866         },
 867
 868         'nasc.def' => {
 869             source => "nasc",
 870             params => "def",
 871             expect => <<'#16...........',
 872         # will break and add semicolon unless -nasc is given
 873         eval {
 874             $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
 875         };
 876 #16...........
 877         },
 878
 879         'nasc.nasc' => {
 880             source => "nasc",
 881             params => "nasc",
 882             expect => <<'#17...........',
 883         # will break and add semicolon unless -nasc is given
 884         eval {
 885             $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed }
 886         };
 887 #17...........
 888         },
 889
 890         'nothing.def' => {
 891             source => "nothing",
 892             params => "def",
 893             expect => <<'#18...........',
 894 #18...........
 895         },
 896
 897         'nothing.nothing' => {
 898             source => "nothing",
 899             params => "nothing",
 900             expect => <<'#19...........',
 901 #19...........
 902         },
 903
 904         'otr1.def' => {
 905             source => "otr1",
 906             params => "def",
 907             expect => <<'#20...........',
 908 return $pdl->slice(
 909     join ',',
 910     (
 911         map {
 912                 $_ eq "X"         ? ":"
 913               : ref $_ eq "ARRAY" ? join ':', @$_
 914               : !ref $_           ? $_
 915               : die "INVALID SLICE DEF $_"
 916         } @_
 917     )
 918 );
 919 #20...........
 920         },
 921     };
 922
 923     my $ntests = 0 + keys %{$rtests};
 924     plan tests => $ntests;
 925 }
 926
 927 ###############
 928 # EXECUTE TESTS
 929 ###############
 930
 931 foreach my $key ( sort keys %{$rtests} ) {
 932     my $output;
 933     my $sname  = $rtests->{$key}->{source};
 934     my $expect = $rtests->{$key}->{expect};
 935     my $pname  = $rtests->{$key}->{params};
 936     my $source = $rsources->{$sname};
 937     my $params = defined($pname) ? $rparams->{$pname} : "";
 938     my $stderr_string;
 939     my $errorfile_string;
 940     my $err = Perl::Tidy::perltidy(
 941         source      => \$source,
 942         destination => \$output,
 943         perltidyrc  => \$params,
 944         argv        => '',             # for safety; hide any ARGV from perltidy
 945         stderr      => \$stderr_string,
 946         errorfile   => \$errorfile_string,    # not used when -se flag is set
 947     );
 948     if ( $err || $stderr_string || $errorfile_string ) {
 949         print STDERR "Error output received for test '$key'\n";
 950         if ($err) {
 951             print STDERR "An error flag '$err' was returned\n";
 952             ok( !$err );
 953         }
 954         if ($stderr_string) {
 955             print STDERR "---------------------\n";
 956             print STDERR "<<STDERR>>\n$stderr_string\n";
 957             print STDERR "---------------------\n";
 958             ok( !$stderr_string );
 959         }
 960         if ($errorfile_string) {
 961             print STDERR "---------------------\n";
 962             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 963             print STDERR "---------------------\n";
 964             ok( !$errorfile_string );
 965         }
 966     }
 967     else {
 968         if ( !is( $output, $expect, $key ) ) {
 969             my $leno = length($output);
 970             my $lene = length($expect);
 971             if ( $leno == $lene ) {
 972                 print STDERR
 973 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 974             }
 975             else {
 976                 print STDERR
 977 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 978             }
 979         }
 980     }
 981 }