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;
  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 ", $c->br(), "Area "
 603                                   )
 604                               ),
 605                               $c->td(
 606                                       { -valign => 'top' },
 607                                       $c->scrolling_list(
 608                                                      -tabindex => "5",
 609                                                      -name     => "discipline",
 610                                                      -values => [@discipValues],
 611                                                      -labels => \%discipLabels,
 612                                                      -default => "$discipline"
 613                                       ),
 614                               )
 615                           )
 616                       )
 617                   )
 618              ),
 619              $c->Tr(
 620                      { -valign => 'top' },
 621                      $c->td(
 622                              { -colspan => '2' },
 623                              $c->table(
 624                                   $c->Tr(
 625                                       $c->td(
 626                                           { -valign => 'top' },
 627                                           $c->strong(" Relevant Subject Area "),
 628                                           $c->br(),
 629                                           "You may select multiple areas",
 630                                       ),
 631                                       $c->td(
 632                                               { -valign => 'top' },
 633                                               $c->checkbox_group(
 634                                                        -tabindex => "6",
 635                                                        -name     => "subject",
 636                                                        -values => [@subjValues],
 637                                                        -labels => \%subjLabels,
 638                                                        -defaults => [@subject],
 639                                                        -rows     => "2"
 640                                               )
 641                                       )
 642                                   )
 643                              )
 644                      )
 645              ),
 646              $c->Tr(
 647                      { -valign => 'top' },
 648                      $c->td(
 649                              { -colspan => '2' },
 650                              $c->strong("Location<BR>"),
 651                              $c->small("(ie, where to find it)"),
 652                              $c->textfield(
 653                                             -tabindex => "7",
 654                                             -name     => "location",
 655                                             -default  => "$location",
 656                                             -size     => '40'
 657                              )
 658                      )
 659              ),
 660              $c->Tr(
 661                      { -valign => 'top' },
 662                      $c->td(
 663                              { -colspan => '2' },
 664                              $c->table(
 665                                        $c->Tr(
 666                                            $c->td(
 667                                                { -valign => 'top' },
 668                                                "Description", $c->br(),
 669                                                $c->small("Maximum 750 letters.")
 670                                            ),
 671                                            $c->td(
 672                                                  { -valign => 'top' },
 673                                                  $c->textarea(
 674                                                      -tabindex => "8",
 675                                                      -name     => "description",
 676                                                      -default => "$description",
 677                                                      -wrap    => "soft",
 678                                                      -rows    => '10',
 679                                                      -columns => '60'
 680                                                  )
 681                                            )
 682                                        )
 683                              )
 684                      )
 685              ),
 686   );
 687 #5...........
 688         },
 689
 690         'mangle1.def' => {
 691             source => "mangle1",
 692             params => "def",
 693             expect => <<'#6...........',
 694 # The space after the '?' is essential and must not be deleted
 695 print $::opt_m ? "  Files:  " . my_wrap( "", "          ", $v ) : $v;
 696 #6...........
 697         },
 698
 699         'mangle1.mangle' => {
 700             source => "mangle1",
 701             params => "mangle",
 702             expect => <<'#7...........',
 703 # The space after the '?' is essential and must not be deleted
 704 print$::opt_m ? "  Files:  ".my_wrap("","          ",$v):$v;
 705 #7...........
 706         },
 707
 708         'mangle2.def' => {
 709             source => "mangle2",
 710             params => "def",
 711             expect => <<'#8...........',
 712 # hanging side comments - do not remove leading space with -mangle
 713 if ( $size1 == 0 || $size2 == 0 ) {    # special handling for zero-length
 714     if ( $size2 + $size1 == 0 ) {      # files.
 715         exit 0;
 716     }
 717     else {                             # Can't we say 'differ at byte zero'
 718                                        # and so on here?  That might make
 719                                        # more sense than this behavior.
 720                                        # Also, this should be made consistent
 721                                        # with the behavior when skip >=
 722                                        # filesize.
 723         if ($volume) {
 724             warn "$0: EOF on $file1\n" unless $size1;
 725             warn "$0: EOF on $file2\n" unless $size2;
 726         }
 727         exit 1;
 728     }
 729 }
 730
 731 #8...........
 732         },
 733
 734         'mangle2.mangle' => {
 735             source => "mangle2",
 736             params => "mangle",
 737             expect => <<'#9...........',
 738 # hanging side comments - do not remove leading space with -mangle
 739 if($size1==0||$size2==0){# special handling for zero-length
 740 if($size2+$size1==0){# files.
 741 exit 0;}else{# Can't we say 'differ at byte zero'
 742  # and so on here?  That might make
 743  # more sense than this behavior.
 744  # Also, this should be made consistent
 745  # with the behavior when skip >=
 746  # filesize.
 747 if($volume){warn"$0: EOF on $file1\n" unless$size1;
 748 warn"$0: EOF on $file2\n" unless$size2;}exit 1;}}
 749 #9...........
 750         },
 751
 752         'mangle3.def' => {
 753             source => "mangle3",
 754             params => "def",
 755             expect => <<'#10...........',
 756 # run with --mangle
 757 # Troublesome punctuation variables: $$ and $#
 758
 759 # don't delete ws between '$$' and 'if'
 760 kill 'ABRT', $$ if $panic++;
 761
 762 # Do not remove the space between '$#' and 'eq'
 763 $, = "Hello, World!\n";
 764 $# = $,;
 765 print "$# ";
 766 $# eq $, ? print "yes\n" : print "no\n";
 767
 768 # The space after the '?' is essential and must not be deleted
 769 print $::opt_m ? "  Files:  " . my_wrap( "", "          ", $v ) : $v;
 770
 771 # must not remove space before 'CAKE'
 772 use constant CAKE => atan2( 1, 1 ) / 2;
 773 if ( $arc >= - CAKE && $arc <= CAKE ) {
 774 }
 775
 776 # do not remove the space after 'JUNK':
 777 print JUNK ( "<", "&", ">" )[ rand(3) ];    # make these a bit more likely
 778 #10...........
 779         },
 780
 781         'mangle3.mangle' => {
 782             source => "mangle3",
 783             params => "mangle",
 784             expect => <<'#11...........',
 785 # run with --mangle
 786 # Troublesome punctuation variables: $$ and $#
 787 # don't delete ws between '$$' and 'if'
 788 kill 'ABRT',$$ if$panic++;
 789 # Do not remove the space between '$#' and 'eq'
 790 $,="Hello, World!\n";
 791 $#=$,;
 792 print"$# ";
 793 $# eq$,?print"yes\n":print"no\n";
 794 # The space after the '?' is essential and must not be deleted
 795 print$::opt_m ? "  Files:  ".my_wrap("","          ",$v):$v;
 796 # must not remove space before 'CAKE'
 797 use constant CAKE=>atan2(1,1)/2;
 798 if($arc>=- CAKE&&$arc<=CAKE){}
 799 # do not remove the space after 'JUNK':
 800 print JUNK ("<","&",">")[rand(3)];# make these a bit more likely
 801 #11...........
 802         },
 803
 804         'math1.def' => {
 805             source => "math1",
 806             params => "def",
 807             expect => <<'#12...........',
 808 my $xyz_shield = [
 809     [ -0.060,  -0.060,  0. ],
 810     [ 0.060,   -0.060,  0. ],
 811     [ 0.060,   0.060,   0. ],
 812     [ -0.060,  0.060,   0. ],
 813     [ -0.0925, -0.0925, 0.092 ],
 814     [ 0.0925,  -0.0925, 0.092 ],
 815     [ 0.0925,  0.0925,  0.092 ],
 816     [ -0.0925, 0.0925,  0.092 ],
 817 ];
 818 #12...........
 819         },
 820
 821         'math2.def' => {
 822             source => "math2",
 823             params => "def",
 824             expect => <<'#13...........',
 825 $ans = pdl(
 826     [ 0, 0, 0, 0, 0 ],
 827     [ 0, 0, 2, 0, 0 ],
 828     [ 0, 1, 5, 2, 0 ],
 829     [ 0, 0, 4, 0, 0 ],
 830     [ 0, 0, 0, 0, 0 ]
 831 );
 832 #13...........
 833         },
 834
 835         'math3.def' => {
 836             source => "math3",
 837             params => "def",
 838             expect => <<'#14...........',
 839     my ( $x, $y ) = (
 840         $x0 +
 841           $index_x * $xgridwidth * $xm +
 842           ( $map_x * $xm * $xgridwidth ) / $detailwidth,
 843         $y0 -
 844           $index_y * $ygridwidth * $ym -
 845           ( $map_y * $ym * $ygridwidth ) / $detailheight,
 846     );
 847 #14...........
 848         },
 849
 850         'math4.def' => {
 851             source => "math4",
 852             params => "def",
 853             expect => <<'#15...........',
 854 my $u      = ( $range * $pratio**( 1. / 3. ) ) / $wratio;
 855 my $factor = exp( -( 18 / $u )**4 );
 856 my $ovp    = ( 1 - $factor ) * ( 70 - 0.655515 * $u ) +
 857   ( 1000 / ( $u**1.3 ) + 10000 / ( $u**3.3 ) ) * $factor;
 858 my $impulse =
 859   ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
 860 $ovp     = $ovp * $pratio;
 861 $impulse = $impulse * $wratio * $pratio**( 2 / 3 );
 862 #15...........
 863         },
 864
 865         'nasc.def' => {
 866             source => "nasc",
 867             params => "def",
 868             expect => <<'#16...........',
 869         # will break and add semicolon unless -nasc is given
 870         eval {
 871             $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
 872         };
 873 #16...........
 874         },
 875
 876         'nasc.nasc' => {
 877             source => "nasc",
 878             params => "nasc",
 879             expect => <<'#17...........',
 880         # will break and add semicolon unless -nasc is given
 881         eval {
 882             $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed }
 883         };
 884 #17...........
 885         },
 886
 887         'nothing.def' => {
 888             source => "nothing",
 889             params => "def",
 890             expect => <<'#18...........',
 891 #18...........
 892         },
 893
 894         'nothing.nothing' => {
 895             source => "nothing",
 896             params => "nothing",
 897             expect => <<'#19...........',
 898 #19...........
 899         },
 900
 901         'otr1.def' => {
 902             source => "otr1",
 903             params => "def",
 904             expect => <<'#20...........',
 905 return $pdl->slice(
 906     join ',',
 907     (
 908         map {
 909                 $_ eq "X" ? ":"
 910               : ref $_ eq "ARRAY" ? join ':', @$_
 911               : !ref $_ ? $_
 912               : die "INVALID SLICE DEF $_"
 913         } @_
 914     )
 915 );
 916 #20...........
 917         },
 918     };
 919
 920     my $ntests = 0 + keys %{$rtests};
 921     plan tests => $ntests;
 922 }
 923
 924 ###############
 925 # EXECUTE TESTS
 926 ###############
 927
 928 foreach my $key ( sort keys %{$rtests} ) {
 929     my $output;
 930     my $sname  = $rtests->{$key}->{source};
 931     my $expect = $rtests->{$key}->{expect};
 932     my $pname  = $rtests->{$key}->{params};
 933     my $source = $rsources->{$sname};
 934     my $params = defined($pname) ? $rparams->{$pname} : "";
 935     my $stderr_string;
 936     my $errorfile_string;
 937     my $err = Perl::Tidy::perltidy(
 938         source      => \$source,
 939         destination => \$output,
 940         perltidyrc  => \$params,
 941         argv        => '',             # for safety; hide any ARGV from perltidy
 942         stderr      => \$stderr_string,
 943         errorfile => \$errorfile_string,    # not used when -se flag is set
 944     );
 945     if ( $err || $stderr_string || $errorfile_string ) {
 946         if ($err) {
 947             print STDERR
 948 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 949             ok( !$err );
 950         }
 951         if ($stderr_string) {
 952             print STDERR "---------------------\n";
 953             print STDERR "<<STDERR>>\n$stderr_string\n";
 954             print STDERR "---------------------\n";
 955             print STDERR
 956 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 957             ok( !$stderr_string );
 958         }
 959         if ($errorfile_string) {
 960             print STDERR "---------------------\n";
 961             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 962             print STDERR "---------------------\n";
 963             print STDERR
 964 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 965             ok( !$errorfile_string );
 966         }
 967     }
 968     else {
 969         ok( $output, $expect );
 970     }
 971 }