t/snippets3.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 ce_wn1.ce_wn
   5 #2 ce_wn1.def
   6 #3 colin.colin
   7 #4 colin.def
   8 #5 essential.def
   9 #6 essential.essential1
  10 #7 essential.essential2
  11 #8 extrude1.def
  12 #9 extrude1.extrude
  13 #10 extrude2.def
  14 #11 extrude2.extrude
  15 #12 extrude3.def
  16 #13 extrude3.extrude
  17 #14 extrude4.def
  18 #15 extrude4.extrude
  19 #16 fabrice_bug.def
  20 #17 fabrice_bug.fabrice_bug
  21 #18 format1.def
  22 #19 given1.def
  23 #20 gnu1.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         'ce_wn' => <<'----------',
  42 -cuddled-blocks
  43 -wn
  44 ----------
  45         'colin' => <<'----------',
  46 -l=0
  47 -pt=2
  48 -nsfs
  49 -sbt=2
  50 -ohbr
  51 -opr
  52 -osbr
  53 -pvt=2
  54 -schb
  55 -scp
  56 -scsb
  57 -sohb
  58 -sop
  59 -sosb
  60 ----------
  61         'def'        => "",
  62         'essential1' => <<'----------',
  63 -syn
  64 -i=0
  65 -l=100000
  66 -nasc
  67 -naws
  68 -dws
  69 -nanl
  70 -blbp=0
  71 -blbs=0
  72 -nbbb
  73 -kbl=0
  74 -mbl=0
  75 ----------
  76         'essential2'  => "-extrude",
  77         'extrude'     => "--extrude",
  78         'fabrice_bug' => "-bt=0",
  79     };
  80
  81     ############################
  82     # BEGIN SECTION 2: Sources #
  83     ############################
  84     $rsources = {
  85
  86         'ce_wn1' => <<'----------',
  87 if ($BOLD_MATH) {
  88     (
  89         $labels, $comment,
  90         join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
  91       )
  92 }
  93 else {
  94     (
  95         &process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
  96         $after
  97       )
  98 }
  99 ----------
 100
 101         'colin' => <<'----------',
 102 env(0, 15, 0, 10, {
 103     Xtitle => 'X-data',
 104     Ytitle => 'Y-data',
 105     Title  => 'An example of errb and points',
 106     Font   => 'Italic'
 107 });
 108 ----------
 109
 110         'essential' => <<'----------',
 111 # Run with mangle to squeeze out the white space
 112 # also run with extrude
 113
 114 # never combine two bare words or numbers
 115 status and ::ok(1);
 116
 117 return ::spw(...);
 118
 119 for bla::bla:: abc;
 120
 121 # do not combine 'overload::' and 'and'
 122 if $self->{bareStringify} and ref $_
 123 and defined %overload:: and defined &{'overload::StrVal'};
 124
 125 # do not combine 'SINK' and 'if'
 126 my $size=-s::SINK if $file;
 127
 128 # do not combine to make $inputeq"quit"
 129 if ($input eq"quit");
 130
 131 # do not combine a number with a concatenation dot to get a float '78.'
 132 $vt100_compatible ? "\e[0;0H" : ('-' x 78 . "\n");
 133
 134 # do not join a minus with a bare word, because you might form
 135 # a file test operator.  Here  "z-i" would be taken as a file test.
 136 if (CORE::abs($z - i) < $eps);
 137
 138 # '= -' should not become =- or you will get a warning
 139
 140 # and something like these could become ambiguous without space
 141 # after the '-':
 142 use constant III=>1;
 143 $a = $b - III;
 144 $a = - III;
 145
 146 # keep a space between a token ending in '$' and any word;
 147 die @$ if $@;
 148
 149 # avoid combining tokens to create new meanings. Example:
 150 # this must not become $a++$b
 151 $a+ +$b;
 152
 153 # another example: do not combine these two &'s:
 154 allow_options & &OPT_EXECCGI;
 155
 156 # Perl is sensitive to whitespace after the + here:
 157 $b = xvals $a + 0.1 * yvals $a;
 158
 159 # keep paren separate here:
 160 use Foo::Bar ();
 161
 162 # need space after foreach my; for example, this will fail in
 163 # older versions of Perl:
 164 foreach my$ft(@filetypes)...
 165
 166 # must retain space between grep and left paren; "grep(" may fail
 167 my $match = grep (m/^-extrude$/, @list) ? 1 : 0;
 168
 169 # don't stick numbers next to left parens, as in:
 170 use Mail::Internet 1.28 ();
 171
 172 # do not remove space between an '&' and a bare word because
 173 # it may turn into a function evaluation, like here
 174 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
 175 $opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
 176 ----------
 177
 178         'extrude1' => <<'----------',
 179 # do not break before the ++
 180 print $x++ . "\n";
 181 ----------
 182
 183         'extrude2' => <<'----------',
 184     if (-l pid_filename()) {
 185         return readlink(pid_filename());
 186     }
 187 ----------
 188
 189         'extrude3' => <<'----------',
 190 # Breaking before a ++ can cause perl to guess wrong
 191 print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
 192
 193 # Space between '&' and 'O_ACCMODE' is essential here
 194 $opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
 195 ----------
 196
 197         'extrude4' => <<'----------',
 198 # From Safe.pm caused trouble with extrude
 199 use Opcode 1.01, qw(
 200   opset opset_to_ops opmask_add
 201   empty_opset full_opset invert_opset verify_opset
 202   opdesc opcodes opmask define_optag opset_to_hex
 203 );
 204 ----------
 205
 206         'fabrice_bug' => <<'----------',
 207 # no space around ^variable with -bt=0
 208 my $before = ${^PREMATCH};
 209 my $after  = ${PREMATCH};
 210 ----------
 211
 212         'format1' => <<'----------',
 213     if (/^--list$/o) {
 214         format =
 215 @<<<<<<<<<<<<<<<<<<<<<<<<       @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 216 $_, $val
 217 .
 218           print "Available strips:\n";
 219         for ( split ( /\|/, $known_strips ) ) {
 220             $val = $defs{$_}{'name'};
 221             write;
 222         }
 223     }
 224 ----------
 225
 226         'given1' => <<'----------',
 227         given ([9,"a",11]) {
 228                 when (qr/\d/)  {
 229                                 given ($count) {
 230                                         when (1)      { ok($count==1) }
 231                                                 else { ok($count!=1) }
 232                                         when ([5,6])  { ok(0) } else { ok(1) }
 233                                 }
 234                             }
 235                 ok(1) when 11;
 236         }
 237 ----------
 238
 239         'gnu1' => <<'----------',
 240 @common_sometimes = (
 241     "aclocal.m4", "acconfig.h", "config.h.top", "config.h.bot",
 242     "stamp-h.in", 'stamp-vti'
 243 );
 244 ----------
 245     };
 246
 247     ####################################
 248     # BEGIN SECTION 3: Expected output #
 249     ####################################
 250     $rtests = {
 251
 252         'ce_wn1.ce_wn' => {
 253             source => "ce_wn1",
 254             params => "ce_wn",
 255             expect => <<'#1...........',
 256 if ($BOLD_MATH) { (
 257     $labels, $comment,
 258     join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
 259 ) } else { (
 260     &process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
 261     $after
 262 ) }
 263 #1...........
 264         },
 265
 266         'ce_wn1.def' => {
 267             source => "ce_wn1",
 268             params => "def",
 269             expect => <<'#2...........',
 270 if ($BOLD_MATH) {
 271     (
 272         $labels, $comment,
 273         join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
 274     )
 275 }
 276 else {
 277     (
 278         &process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
 279         $after
 280     )
 281 }
 282 #2...........
 283         },
 284
 285         'colin.colin' => {
 286             source => "colin",
 287             params => "colin",
 288             expect => <<'#3...........',
 289 env(0, 15, 0, 10, {
 290     Xtitle => 'X-data',
 291     Ytitle => 'Y-data',
 292     Title  => 'An example of errb and points',
 293     Font   => 'Italic'
 294 });
 295 #3...........
 296         },
 297
 298         'colin.def' => {
 299             source => "colin",
 300             params => "def",
 301             expect => <<'#4...........',
 302 env(
 303     0, 15, 0, 10,
 304     {
 305         Xtitle => 'X-data',
 306         Ytitle => 'Y-data',
 307         Title  => 'An example of errb and points',
 308         Font   => 'Italic'
 309     }
 310 );
 311 #4...........
 312         },
 313
 314         'essential.def' => {
 315             source => "essential",
 316             params => "def",
 317             expect => <<'#5...........',
 318 # Run with mangle to squeeze out the white space
 319 # also run with extrude
 320
 321 # never combine two bare words or numbers
 322 status and ::ok(1);
 323
 324 return ::spw(...);
 325
 326 for bla::bla:: abc;
 327
 328 # do not combine 'overload::' and 'and'
 329 if $self->{bareStringify}
 330   and ref $_
 331   and defined %overload::
 332   and defined &{'overload::StrVal'};
 333
 334 # do not combine 'SINK' and 'if'
 335 my $size = -s ::SINK if $file;
 336
 337 # do not combine to make $inputeq"quit"
 338 if ( $input eq "quit" );
 339
 340 # do not combine a number with a concatenation dot to get a float '78.'
 341 $vt100_compatible ? "\e[0;0H" : ( '-' x 78 . "\n" );
 342
 343 # do not join a minus with a bare word, because you might form
 344 # a file test operator.  Here  "z-i" would be taken as a file test.
 345 if ( CORE::abs( $z - i ) < $eps );
 346
 347 # '= -' should not become =- or you will get a warning
 348
 349 # and something like these could become ambiguous without space
 350 # after the '-':
 351 use constant III => 1;
 352 $a = $b - III;
 353 $a = - III;
 354
 355 # keep a space between a token ending in '$' and any word;
 356 die @$ if $@;
 357
 358 # avoid combining tokens to create new meanings. Example:
 359 # this must not become $a++$b
 360 $a + +$b;
 361
 362 # another example: do not combine these two &'s:
 363 allow_options & &OPT_EXECCGI;
 364
 365 # Perl is sensitive to whitespace after the + here:
 366 $b = xvals $a + 0.1 * yvals $a;
 367
 368 # keep paren separate here:
 369 use Foo::Bar ();
 370
 371 # need space after foreach my; for example, this will fail in
 372 # older versions of Perl:
 373 foreach my $ft (@filetypes) ...
 374
 375   # must retain space between grep and left paren; "grep(" may fail
 376   my $match = grep ( m/^-extrude$/, @list ) ? 1 : 0;
 377
 378 # don't stick numbers next to left parens, as in:
 379 use Mail::Internet 1.28 ();
 380
 381 # do not remove space between an '&' and a bare word because
 382 # it may turn into a function evaluation, like here
 383 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
 384 $opts{rdonly} = ( ( $opts{mode} & O_ACCMODE ) == O_RDONLY );
 385 #5...........
 386         },
 387
 388         'essential.essential1' => {
 389             source => "essential",
 390             params => "essential1",
 391             expect => <<'#6...........',
 392 # Run with mangle to squeeze out the white space
 393 # also run with extrude
 394 # never combine two bare words or numbers
 395 status and ::ok(1);
 396 return ::spw(...);
 397 for bla::bla:: abc;
 398 # do not combine 'overload::' and 'and'
 399 if$self->{bareStringify}and ref$_ and defined%overload:: and defined&{'overload::StrVal'};
 400 # do not combine 'SINK' and 'if'
 401 my$size=-s::SINK if$file;
 402 # do not combine to make $inputeq"quit"
 403 if($input eq"quit");
 404 # do not combine a number with a concatenation dot to get a float '78.'
 405 $vt100_compatible?"\e[0;0H":('-' x 78 ."\n");
 406 # do not join a minus with a bare word, because you might form
 407 # a file test operator.  Here  "z-i" would be taken as a file test.
 408 if(CORE::abs($z- i)<$eps);
 409 # '= -' should not become =- or you will get a warning
 410 # and something like these could become ambiguous without space
 411 # after the '-':
 412 use constant III=>1;
 413 $a=$b- III;
 414 $a=- III;
 415 # keep a space between a token ending in '$' and any word;
 416 die@$ if$@;
 417 # avoid combining tokens to create new meanings. Example:
 418 # this must not become $a++$b
 419 $a+ +$b;
 420 # another example: do not combine these two &'s:
 421 allow_options& &OPT_EXECCGI;
 422 # Perl is sensitive to whitespace after the + here:
 423 $b=xvals$a + 0.1*yvals$a;
 424 # keep paren separate here:
 425 use Foo::Bar ();
 426 # need space after foreach my; for example, this will fail in
 427 # older versions of Perl:
 428 foreach my$ft(@filetypes)...
 429   # must retain space between grep and left paren; "grep(" may fail
 430   my$match=grep (m/^-extrude$/,@list)?1:0;
 431 # don't stick numbers next to left parens, as in:
 432 use Mail::Internet 1.28 ();
 433 # do not remove space between an '&' and a bare word because
 434 # it may turn into a function evaluation, like here
 435 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
 436 $opts{rdonly}=(($opts{mode}& O_ACCMODE)==O_RDONLY);
 437 #6...........
 438         },
 439
 440         'essential.essential2' => {
 441             source => "essential",
 442             params => "essential2",
 443             expect => <<'#7...........',
 444 # Run with mangle to squeeze out the white space
 445 # also run with extrude
 446 # never combine two bare words or numbers
 447 status
 448 and
 449 ::ok(
 450 1
 451 )
 452 ;
 453 return
 454 ::spw(
 455 ...
 456 )
 457 ;
 458 for
 459 bla::bla::
 460 abc
 461 ;
 462 # do not combine 'overload::' and 'and'
 463 if
 464 $self
 465 ->
 466 {bareStringify}
 467 and
 468 ref
 469 $_
 470 and
 471 defined
 472 %overload::
 473 and
 474 defined
 475 &{
 476 'overload::StrVal'
 477 }
 478 ;
 479 # do not combine 'SINK' and 'if'
 480 my$size
 481 =
 482 -s::SINK
 483 if
 484 $file
 485 ;
 486 # do not combine to make $inputeq"quit"
 487 if
 488 (
 489 $input
 490 eq
 491 "quit"
 492 )
 493 ;
 494 # do not combine a number with a concatenation dot to get a float '78.'
 495 $vt100_compatible?
 496 "\e[0;0H"
 497 :
 498 (
 499 '-'
 500 x
 501 78
 502 .
 503 "\n"
 504 )
 505 ;
 506 # do not join a minus with a bare word, because you might form
 507 # a file test operator.  Here  "z-i" would be taken as a file test.
 508 if
 509 (
 510 CORE::abs
 511 (
 512 $z
 513 -
 514 i
 515 )
 516 <
 517 $eps
 518 )
 519 ;
 520 # '= -' should not become =- or you will get a warning
 521 # and something like these could become ambiguous without space
 522 # after the '-':
 523 use
 524 constant
 525 III=>
 526 1
 527 ;
 528 $a
 529 =
 530 $b
 531 -
 532 III
 533 ;
 534 $a
 535 =
 536 -
 537 III
 538 ;
 539 # keep a space between a token ending in '$' and any word;
 540 die
 541 @$
 542 if
 543 $@
 544 ;
 545 # avoid combining tokens to create new meanings. Example:
 546 # this must not become $a++$b
 547 $a
 548 +
 549 +
 550 $b
 551 ;
 552 # another example: do not combine these two &'s:
 553 allow_options
 554 &
 555 &OPT_EXECCGI
 556 ;
 557 # Perl is sensitive to whitespace after the + here:
 558 $b
 559 =
 560 xvals$a
 561 +
 562 0.1
 563 *
 564 yvals$a;
 565 # keep paren separate here:
 566 use
 567 Foo::Bar (
 568 )
 569 ;
 570 # need space after foreach my; for example, this will fail in
 571 # older versions of Perl:
 572 foreach
 573 my$ft
 574 (
 575 @filetypes
 576 )
 577 ...
 578 # must retain space between grep and left paren; "grep(" may fail
 579 my$match
 580 =
 581 grep
 582 (
 583 m/^-extrude$/
 584 ,
 585 @list
 586 )
 587 ?
 588 1
 589 :
 590 0
 591 ;
 592 # don't stick numbers next to left parens, as in:
 593 use
 594 Mail::Internet
 595 1.28
 596 (
 597 )
 598 ;
 599 # do not remove space between an '&' and a bare word because
 600 # it may turn into a function evaluation, like here
 601 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
 602 $opts{rdonly}
 603 =
 604 (
 605 (
 606 $opts{mode}
 607 &
 608 O_ACCMODE
 609 )
 610 ==
 611 O_RDONLY
 612 )
 613 ;
 614 #7...........
 615         },
 616
 617         'extrude1.def' => {
 618             source => "extrude1",
 619             params => "def",
 620             expect => <<'#8...........',
 621 # do not break before the ++
 622 print $x++ . "\n";
 623 #8...........
 624         },
 625
 626         'extrude1.extrude' => {
 627             source => "extrude1",
 628             params => "extrude",
 629             expect => <<'#9...........',
 630 # do not break before the ++
 631 print$x++
 632 .
 633 "\n"
 634 ;
 635 #9...........
 636         },
 637
 638         'extrude2.def' => {
 639             source => "extrude2",
 640             params => "def",
 641             expect => <<'#10...........',
 642     if ( -l pid_filename() ) {
 643         return readlink( pid_filename() );
 644     }
 645 #10...........
 646         },
 647
 648         'extrude2.extrude' => {
 649             source => "extrude2",
 650             params => "extrude",
 651             expect => <<'#11...........',
 652 if
 653 (
 654 -l pid_filename(
 655 )
 656 )
 657 {
 658 return
 659 readlink
 660 (
 661 pid_filename(
 662 )
 663 )
 664 ;
 665 }
 666 #11...........
 667         },
 668
 669         'extrude3.def' => {
 670             source => "extrude3",
 671             params => "def",
 672             expect => <<'#12...........',
 673 # Breaking before a ++ can cause perl to guess wrong
 674 print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
 675
 676 # Space between '&' and 'O_ACCMODE' is essential here
 677 $opts{rdonly} = ( ( $opts{mode} & O_ACCMODE ) == O_RDONLY );
 678 #12...........
 679         },
 680
 681         'extrude3.extrude' => {
 682             source => "extrude3",
 683             params => "extrude",
 684             expect => <<'#13...........',
 685 # Breaking before a ++ can cause perl to guess wrong
 686 print
 687 (
 688 (
 689 $i++
 690 &
 691 1
 692 )
 693 ?
 694 $_
 695 :
 696 (
 697 $change{
 698 $_
 699 }
 700 ||
 701 $_
 702 )
 703 )
 704 ;
 705 # Space between '&' and 'O_ACCMODE' is essential here
 706 $opts{rdonly}
 707 =
 708 (
 709 (
 710 $opts{mode}
 711 &
 712 O_ACCMODE
 713 )
 714 ==
 715 O_RDONLY
 716 )
 717 ;
 718 #13...........
 719         },
 720
 721         'extrude4.def' => {
 722             source => "extrude4",
 723             params => "def",
 724             expect => <<'#14...........',
 725 # From Safe.pm caused trouble with extrude
 726 use Opcode 1.01, qw(
 727   opset opset_to_ops opmask_add
 728   empty_opset full_opset invert_opset verify_opset
 729   opdesc opcodes opmask define_optag opset_to_hex
 730 );
 731 #14...........
 732         },
 733
 734         'extrude4.extrude' => {
 735             source => "extrude4",
 736             params => "extrude",
 737             expect => <<'#15...........',
 738 # From Safe.pm caused trouble with extrude
 739 use
 740 Opcode
 741 1.01
 742 ,
 743 qw(
 744 opset opset_to_ops opmask_add
 745 empty_opset full_opset invert_opset verify_opset
 746 opdesc opcodes opmask define_optag opset_to_hex
 747 )
 748 ;
 749 #15...........
 750         },
 751
 752         'fabrice_bug.def' => {
 753             source => "fabrice_bug",
 754             params => "def",
 755             expect => <<'#16...........',
 756 # no space around ^variable with -bt=0
 757 my $before = ${^PREMATCH};
 758 my $after  = ${PREMATCH};
 759 #16...........
 760         },
 761
 762         'fabrice_bug.fabrice_bug' => {
 763             source => "fabrice_bug",
 764             params => "fabrice_bug",
 765             expect => <<'#17...........',
 766 # no space around ^variable with -bt=0
 767 my $before = ${^PREMATCH};
 768 my $after  = ${ PREMATCH };
 769 #17...........
 770         },
 771
 772         'format1.def' => {
 773             source => "format1",
 774             params => "def",
 775             expect => <<'#18...........',
 776     if (/^--list$/o) {
 777         format =
 778 @<<<<<<<<<<<<<<<<<<<<<<<<       @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 779 $_, $val
 780 .
 781         print "Available strips:\n";
 782         for ( split( /\|/, $known_strips ) ) {
 783             $val = $defs{$_}{'name'};
 784             write;
 785         }
 786     }
 787 #18...........
 788         },
 789
 790         'given1.def' => {
 791             source => "given1",
 792             params => "def",
 793             expect => <<'#19...........',
 794         given ( [ 9, "a", 11 ] ) {
 795             when (qr/\d/) {
 796                 given ($count) {
 797                     when (1)          { ok( $count == 1 ) }
 798                     else              { ok( $count != 1 ) }
 799                     when ( [ 5, 6 ] ) { ok(0) }
 800                     else              { ok(1) }
 801                 }
 802             }
 803             ok(1) when 11;
 804         }
 805 #19...........
 806         },
 807
 808         'gnu1.def' => {
 809             source => "gnu1",
 810             params => "def",
 811             expect => <<'#20...........',
 812 @common_sometimes = (
 813     "aclocal.m4", "acconfig.h", "config.h.top", "config.h.bot",
 814     "stamp-h.in", 'stamp-vti'
 815 );
 816 #20...........
 817         },
 818     };
 819
 820     my $ntests = 0 + keys %{$rtests};
 821     plan tests => $ntests;
 822 }
 823
 824 ###############
 825 # EXECUTE TESTS
 826 ###############
 827
 828 foreach my $key ( sort keys %{$rtests} ) {
 829     my $output;
 830     my $sname  = $rtests->{$key}->{source};
 831     my $expect = $rtests->{$key}->{expect};
 832     my $pname  = $rtests->{$key}->{params};
 833     my $source = $rsources->{$sname};
 834     my $params = defined($pname) ? $rparams->{$pname} : "";
 835     my $stderr_string;
 836     my $errorfile_string;
 837     my $err = Perl::Tidy::perltidy(
 838         source      => \$source,
 839         destination => \$output,
 840         perltidyrc  => \$params,
 841         argv        => '',             # for safety; hide any ARGV from perltidy
 842         stderr      => \$stderr_string,
 843         errorfile   => \$errorfile_string,    # not used when -se flag is set
 844     );
 845     if ( $err || $stderr_string || $errorfile_string ) {
 846         print STDERR "Error output received for test '$key'\n";
 847         if ($err) {
 848             print STDERR "An error flag '$err' was returned\n";
 849             ok( !$err );
 850         }
 851         if ($stderr_string) {
 852             print STDERR "---------------------\n";
 853             print STDERR "<<STDERR>>\n$stderr_string\n";
 854             print STDERR "---------------------\n";
 855             ok( !$stderr_string );
 856         }
 857         if ($errorfile_string) {
 858             print STDERR "---------------------\n";
 859             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 860             print STDERR "---------------------\n";
 861             ok( !$errorfile_string );
 862         }
 863     }
 864     else {
 865         if ( !is( $output, $expect, $key ) ) {
 866             my $leno = length($output);
 867             my $lene = length($expect);
 868             if ( $leno == $lene ) {
 869                 print STDERR
 870 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 871             }
 872             else {
 873                 print STDERR
 874 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 875             }
 876         }
 877     }
 878 }