t/snippets20.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 space6.def
   5 #2 space6.space6
   6 #3 sub3.def
   7 #4 wc.def
   8 #5 wc.wc1
   9 #6 wc.wc2
  10 #7 ce2.ce
  11 #8 ce2.def
  12 #9 gnu6.def
  13 #10 gnu6.gnu
  14 #11 git25.def
  15 #12 git25.git25
  16 #13 outdent.outdent2
  17 #14 kpit.def
  18 #15 kpit.kpit
  19 #16 kpitl.def
  20 #17 kpitl.kpitl
  21 #18 hanging_side_comments3.def
  22 #19 lop.def
  23
  24 # To locate test #13 you can search for its name or the string '#13'
  25
  26 use strict;
  27 use Test::More;
  28 use Carp;
  29 use Perl::Tidy;
  30 my $rparams;
  31 my $rsources;
  32 my $rtests;
  33
  34 BEGIN {
  35
  36     ###########################################
  37     # BEGIN SECTION 1: Parameter combinations #
  38     ###########################################
  39     $rparams = {
  40         'ce'    => "-cuddled-blocks",
  41         'def'   => "",
  42         'git25' => "-l=0",
  43         'gnu'   => "-gnu",
  44         'kpit'  => "-pt=2 -kpit=0",
  45         'kpitl' => <<'----------',
  46 -kpit=0 -kpitl='return factorial' -pt=2
  47 ----------
  48         'outdent2' => <<'----------',
  49 # test -okw and -okwl
  50 -okw -okwl='next'
  51 ----------
  52         'space6' => <<'----------',
  53 -nwrs="+ - / *"
  54 -nwls="+ - / *"
  55 ----------
  56         'wc1' => "-wc=4",
  57         'wc2' => "-wc=4 -wn",
  58     };
  59
  60     ############################
  61     # BEGIN SECTION 2: Sources #
  62     ############################
  63     $rsources = {
  64
  65         'ce2' => <<'----------',
  66 # Previously, perltidy -ce would move a closing brace below a pod section to
  67 # form '} else {'. No longer doing this because if you change back to -nce, the
  68 # brace cannot go back to where it was.
  69 if ($notty) {
  70     $runnonstop = 1;
  71         share($runnonstop);
  72 }
  73
  74 =pod
  75
  76 If there is a TTY, we have to determine who it belongs to before we can
  77 ...
  78
  79 =cut
  80
  81 else {
  82
  83     # Is Perl being run from a slave editor or graphical debugger?
  84     ...
  85 }
  86 ----------
  87
  88         'git25' => <<'----------',
  89 # example for git #25; use -l=0; was losing alignment;  sub 'fix_ragged_lists' was added to fix this
  90 my $mapping = [
  91 # ...
  92     { 'is_col' => 'dsstdat',                      'cr_col' => 'enroll_isaric_date',         'trans' => 0, },
  93     { 'is_col' => 'corona_ieorres',               'cr_col' => '',                           'trans' => 0, },
  94     { 'is_col' => 'symptoms_fever',               'cr_col' => 'elig_fever',                 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
  95     { 'is_col' => 'symptoms_cough',               'cr_col' => 'elig_cough',                 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
  96     { 'is_col' => 'symptoms_dys_tachy_noea',      'cr_col' => 'elig_dyspnea',               'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
  97     { 'is_col' => 'symptoms_clinical_susp',       'cr_col' => 'elig_ari',                   'trans' => 0, },
  98     { 'is_col' => 'sex',                          'cr_col' => 'sex',                        'trans' => 1, 'manually_reviewed' => 1, 'map' => { '0' => '1', '1' => '2' }, },
  99     { 'is_col' => 'age',                          'cr_col' => '',                           'trans' => 0, },
 100     { 'is_col' => 'ageu',                         'cr_col' => '',                           'trans' => 0, },
 101 # ...
 102 ];
 103
 104 ----------
 105
 106         'gnu6' => <<'----------',
 107 # These closing braces no longer have the same position with -gnu after an
 108 # update 13 dec 2021 in which the vertical aligner zeros recoverable spaces.
 109 # But adding the -xlp should make them all have the same indentation.
 110     $var1 = {
 111         'foo10' => undef,
 112         'foo72' => ' ',
 113     };
 114     $var1 = {
 115         'foo10' => undef,
 116         'foo72' => '
 117 ',
 118     };
 119     $var2 = {
 120         'foo72' => '
 121 ',
 122         'foo10' => undef,
 123     };
 124 ----------
 125
 126         'hanging_side_comments3' => <<'----------',
 127     if ( $var eq 'wastebasket' ) {    # this sends a pure block
 128                                       # of hanging side comments
 129                                       #to the vertical aligner.
 130                                       #It caused a crash in
 131                                       #a test version of
 132                                       #sub 'delete_unmatched_tokens'
 133                                       #...
 134                                       #}
 135     }
 136     elsif ( $var eq 'spacecommand' ) {
 137         &die("No $val function") unless eval "defined &$val";
 138     }
 139 ----------
 140
 141         'kpit' => <<'----------',
 142 if ( seek(DATA, 0, 0) ) { ... }
 143
 144 # The foreach keyword may be separated from the next opening paren
 145 foreach $req(@bgQueue) {
 146    ...
 147 }
 148
 149 # This had trouble because a later padding operation removed the inside space
 150 while ($CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
 151         || @CmdQueue > 0 && $RunNightlyWhenIdle == 2 && $bpc->isAdminJob($CmdQueue[0]->{host})) {
 152   ...
 153 }
 154
 155 ----------
 156
 157         'kpitl' => <<'----------',
 158 return ( $r**$n ) * ( pi**( $n / 2 ) ) / ( sqrt(pi) * factorial( 2 * ( int( $n
 159 / 2 ) ) + 2 ) / factorial( int( $n / 2 ) + 1 ) / ( 4**( int( $n / 2 ) + 1 ) )
 160 );
 161 ----------
 162
 163         'lop' => <<'----------',
 164 # logical padding examples
 165 $same =
 166   (      ( $aP eq $bP )
 167       && ( $aS eq $bS )
 168       && ( $aT eq $bT )
 169       && ( $a->{'title'} eq $b->{'title'} )
 170       && ( $a->{'href'} eq $b->{'href'} ) );
 171
 172 $bits =
 173     $top > 0xffff ? 32
 174   : $top > 0xff   ? 16
 175   : $top > 1      ? 8
 176   :                 1;
 177
 178 lc( $self->mime_attr('content-type')
 179         || $self->{MIH_DefaultType}
 180         || 'text/plain' );
 181
 182 # Padding can also remove spaces; here the space after the '(' is lost:
 183 elsif ( $statement_type =~ /^sub\b/
 184     || $paren_type[$paren_depth] =~ /^sub\b/ )
 185 ----------
 186
 187         'outdent' => <<'----------',
 188         my $i;
 189       LOOP: while ( $i = <FOTOS> ) {
 190             chomp($i);
 191             next unless $i;
 192             fixit($i);
 193         }
 194
 195 ----------
 196
 197         'space6' => <<'----------',
 198 # test some spacing rules at possible filehandles
 199 my $z=$x/$y;     # ok to change spaces around both sides of the /
 200 print $x / $y;   # do not remove space before or after / here
 201 print $x/$y;     # do not add a space before the / here
 202 print $x+$y;     # do not add a space before the + here
 203 ----------
 204
 205         'sub3' => <<'----------',
 206 # keep these one-line blocks intact
 207
 208 my $aa = sub
 209 #line 245 "Parse.yp"
 210 { n_stmtexp $_[1] };
 211
 212 my $bb = sub    #
 213 { n_stmtexp $_[1] };
 214 ----------
 215
 216         'wc' => <<'----------',
 217 {
 218     my (@indices) =
 219       sort {
 220         $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
 221     } (0 .. $#cells);
 222
 223 {{{{
 224                     if ( !$array[0] ) {
 225                         $array[0] =
 226                           &$CantProcessPartFunc( $entity->{'fields'}{
 227                           'content-type'} );
 228                     }
 229
 230 }}}}}
 231
 232 ----------
 233     };
 234
 235     ####################################
 236     # BEGIN SECTION 3: Expected output #
 237     ####################################
 238     $rtests = {
 239
 240         'space6.def' => {
 241             source => "space6",
 242             params => "def",
 243             expect => <<'#1...........',
 244 # test some spacing rules at possible filehandles
 245 my $z = $x / $y;    # ok to change spaces around both sides of the /
 246 print $x / $y;      # do not remove space before or after / here
 247 print $x/ $y;       # do not add a space before the / here
 248 print $x+ $y;       # do not add a space before the + here
 249 #1...........
 250         },
 251
 252         'space6.space6' => {
 253             source => "space6",
 254             params => "space6",
 255             expect => <<'#2...........',
 256 # test some spacing rules at possible filehandles
 257 my $z = $x/$y;    # ok to change spaces around both sides of the /
 258 print $x / $y;    # do not remove space before or after / here
 259 print $x/$y;      # do not add a space before the / here
 260 print $x+$y;      # do not add a space before the + here
 261 #2...........
 262         },
 263
 264         'sub3.def' => {
 265             source => "sub3",
 266             params => "def",
 267             expect => <<'#3...........',
 268 # keep these one-line blocks intact
 269
 270 my $aa = sub
 271 #line 245 "Parse.yp"
 272 { n_stmtexp $_[1] };
 273
 274 my $bb = sub    #
 275 { n_stmtexp $_[1] };
 276 #3...........
 277         },
 278
 279         'wc.def' => {
 280             source => "wc",
 281             params => "def",
 282             expect => <<'#4...........',
 283 {
 284     my (@indices) =
 285       sort {
 286         $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
 287       } ( 0 .. $#cells );
 288
 289     {
 290         {
 291             {
 292                 {
 293                     if ( !$array[0] ) {
 294                         $array[0] =
 295                           &$CantProcessPartFunc(
 296                             $entity->{'fields'}{'content-type'} );
 297                     }
 298
 299                 }
 300             }
 301         }
 302     }
 303 }
 304
 305 #4...........
 306         },
 307
 308         'wc.wc1' => {
 309             source => "wc",
 310             params => "wc1",
 311             expect => <<'#5...........',
 312 {
 313     my (@indices) =
 314       sort {
 315         $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
 316       } ( 0 .. $#cells );
 317
 318     {
 319         {
 320             {
 321                 {
 322     if ( !$array[0] ) {
 323         $array[0] =
 324           &$CantProcessPartFunc( $entity->{'fields'}{'content-type'} );
 325     }
 326
 327                 }
 328             }
 329         }
 330     }
 331 }
 332
 333 #5...........
 334         },
 335
 336         'wc.wc2' => {
 337             source => "wc",
 338             params => "wc2",
 339             expect => <<'#6...........',
 340 {
 341     my (@indices) =
 342       sort {
 343         $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
 344       } ( 0 .. $#cells );
 345
 346     { { { {
 347         if ( !$array[0] ) {
 348             $array[0] =
 349               &$CantProcessPartFunc( $entity->{'fields'}{'content-type'} );
 350         }
 351
 352     } } } }
 353 }
 354
 355 #6...........
 356         },
 357
 358         'ce2.ce' => {
 359             source => "ce2",
 360             params => "ce",
 361             expect => <<'#7...........',
 362 # Previously, perltidy -ce would move a closing brace below a pod section to
 363 # form '} else {'. No longer doing this because if you change back to -nce, the
 364 # brace cannot go back to where it was.
 365 if ($notty) {
 366     $runnonstop = 1;
 367     share($runnonstop);
 368
 369 }
 370
 371 =pod
 372
 373 If there is a TTY, we have to determine who it belongs to before we can
 374 ...
 375
 376 =cut
 377
 378 else {
 379
 380     # Is Perl being run from a slave editor or graphical debugger?
 381     ...;
 382 }
 383 #7...........
 384         },
 385
 386         'ce2.def' => {
 387             source => "ce2",
 388             params => "def",
 389             expect => <<'#8...........',
 390 # Previously, perltidy -ce would move a closing brace below a pod section to
 391 # form '} else {'. No longer doing this because if you change back to -nce, the
 392 # brace cannot go back to where it was.
 393 if ($notty) {
 394     $runnonstop = 1;
 395     share($runnonstop);
 396 }
 397
 398 =pod
 399
 400 If there is a TTY, we have to determine who it belongs to before we can
 401 ...
 402
 403 =cut
 404
 405 else {
 406
 407     # Is Perl being run from a slave editor or graphical debugger?
 408     ...;
 409 }
 410 #8...........
 411         },
 412
 413         'gnu6.def' => {
 414             source => "gnu6",
 415             params => "def",
 416             expect => <<'#9...........',
 417     # These closing braces no longer have the same position with -gnu after an
 418     # update 13 dec 2021 in which the vertical aligner zeros recoverable spaces.
 419     # But adding the -xlp should make them all have the same indentation.
 420     $var1 = {
 421         'foo10' => undef,
 422         'foo72' => ' ',
 423     };
 424     $var1 = {
 425         'foo10' => undef,
 426         'foo72' => '
 427 ',
 428     };
 429     $var2 = {
 430         'foo72' => '
 431 ',
 432         'foo10' => undef,
 433     };
 434 #9...........
 435         },
 436
 437         'gnu6.gnu' => {
 438             source => "gnu6",
 439             params => "gnu",
 440             expect => <<'#10...........',
 441     # These closing braces no longer have the same position with -gnu after an
 442     # update 13 dec 2021 in which the vertical aligner zeros recoverable spaces.
 443     # But adding the -xlp should make them all have the same indentation.
 444     $var1 = {
 445              'foo10' => undef,
 446              'foo72' => ' ',
 447             };
 448     $var1 = {
 449         'foo10' => undef,
 450         'foo72' => '
 451 ',
 452     };
 453     $var2 = {
 454         'foo72' => '
 455 ',
 456         'foo10' => undef,
 457             };
 458 #10...........
 459         },
 460
 461         'git25.def' => {
 462             source => "git25",
 463             params => "def",
 464             expect => <<'#11...........',
 465 # example for git #25; use -l=0; was losing alignment;  sub 'fix_ragged_lists' was added to fix this
 466 my $mapping = [
 467
 468     # ...
 469     { 'is_col' => 'dsstdat', 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
 470     { 'is_col' => 'corona_ieorres', 'cr_col' => '',            'trans' => 0, },
 471     {
 472         'is_col'            => 'symptoms_fever',
 473         'cr_col'            => 'elig_fever',
 474         'trans'             => 1,
 475         'manually_reviewed' => '@TODO',
 476         'map'               => { '0' => '0', '1' => '1', '9' => '@TODO' },
 477     },
 478     {
 479         'is_col'            => 'symptoms_cough',
 480         'cr_col'            => 'elig_cough',
 481         'trans'             => 1,
 482         'manually_reviewed' => '@TODO',
 483         'map'               => { '0' => '0', '1' => '1', '9' => '@TODO' },
 484     },
 485     {
 486         'is_col'            => 'symptoms_dys_tachy_noea',
 487         'cr_col'            => 'elig_dyspnea',
 488         'trans'             => 1,
 489         'manually_reviewed' => '@TODO',
 490         'map'               => { '0' => '0', '1' => '1', '9' => '@TODO' },
 491     },
 492     {
 493         'is_col' => 'symptoms_clinical_susp',
 494         'cr_col' => 'elig_ari',
 495         'trans'  => 0,
 496     },
 497     {
 498         'is_col'            => 'sex',
 499         'cr_col'            => 'sex',
 500         'trans'             => 1,
 501         'manually_reviewed' => 1,
 502         'map'               => { '0' => '1', '1' => '2' },
 503     },
 504     { 'is_col' => 'age',  'cr_col' => '', 'trans' => 0, },
 505     { 'is_col' => 'ageu', 'cr_col' => '', 'trans' => 0, },
 506
 507     # ...
 508 ];
 509
 510 #11...........
 511         },
 512
 513         'git25.git25' => {
 514             source => "git25",
 515             params => "git25",
 516             expect => <<'#12...........',
 517 # example for git #25; use -l=0; was losing alignment;  sub 'fix_ragged_lists' was added to fix this
 518 my $mapping = [
 519
 520     # ...
 521     { 'is_col' => 'dsstdat',                 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
 522     { 'is_col' => 'corona_ieorres',          'cr_col' => '',                   'trans' => 0, },
 523     { 'is_col' => 'symptoms_fever',          'cr_col' => 'elig_fever',         'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
 524     { 'is_col' => 'symptoms_cough',          'cr_col' => 'elig_cough',         'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
 525     { 'is_col' => 'symptoms_dys_tachy_noea', 'cr_col' => 'elig_dyspnea',       'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
 526     { 'is_col' => 'symptoms_clinical_susp',  'cr_col' => 'elig_ari',           'trans' => 0, },
 527     { 'is_col' => 'sex',                     'cr_col' => 'sex',                'trans' => 1, 'manually_reviewed' => 1, 'map' => { '0' => '1', '1' => '2' }, },
 528     { 'is_col' => 'age',                     'cr_col' => '',                   'trans' => 0, },
 529     { 'is_col' => 'ageu',                    'cr_col' => '',                   'trans' => 0, },
 530
 531     # ...
 532 ];
 533
 534 #12...........
 535         },
 536
 537         'outdent.outdent2' => {
 538             source => "outdent",
 539             params => "outdent2",
 540             expect => <<'#13...........',
 541         my $i;
 542       LOOP: while ( $i = <FOTOS> ) {
 543             chomp($i);
 544           next unless $i;
 545             fixit($i);
 546         }
 547
 548 #13...........
 549         },
 550
 551         'kpit.def' => {
 552             source => "kpit",
 553             params => "def",
 554             expect => <<'#14...........',
 555 if ( seek( DATA, 0, 0 ) ) { ... }
 556
 557 # The foreach keyword may be separated from the next opening paren
 558 foreach $req (@bgQueue) {
 559     ...;
 560 }
 561
 562 # This had trouble because a later padding operation removed the inside space
 563 while ($CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
 564     || @CmdQueue > 0
 565     && $RunNightlyWhenIdle == 2
 566     && $bpc->isAdminJob( $CmdQueue[0]->{host} ) )
 567 {
 568     ...;
 569 }
 570
 571 #14...........
 572         },
 573
 574         'kpit.kpit' => {
 575             source => "kpit",
 576             params => "kpit",
 577             expect => <<'#15...........',
 578 if ( seek(DATA, 0, 0) ) { ... }
 579
 580 # The foreach keyword may be separated from the next opening paren
 581 foreach $req ( @bgQueue ) {
 582     ...;
 583 }
 584
 585 # This had trouble because a later padding operation removed the inside space
 586 while ( $CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
 587     || @CmdQueue > 0
 588     && $RunNightlyWhenIdle == 2
 589     && $bpc->isAdminJob($CmdQueue[0]->{host}) )
 590 {
 591     ...;
 592 }
 593
 594 #15...........
 595         },
 596
 597         'kpitl.def' => {
 598             source => "kpitl",
 599             params => "def",
 600             expect => <<'#16...........',
 601 return ( $r**$n ) *
 602   ( pi**( $n / 2 ) ) /
 603   (
 604     sqrt(pi) *
 605       factorial( 2 * ( int( $n / 2 ) ) + 2 ) /
 606       factorial( int( $n / 2 ) + 1 ) /
 607       ( 4**( int( $n / 2 ) + 1 ) ) );
 608 #16...........
 609         },
 610
 611         'kpitl.kpitl' => {
 612             source => "kpitl",
 613             params => "kpitl",
 614             expect => <<'#17...........',
 615 return ( $r**$n ) *
 616   (pi**($n / 2)) /
 617   (
 618     sqrt(pi) *
 619       factorial( 2 * (int($n / 2)) + 2 ) /
 620       factorial( int($n / 2) + 1 ) /
 621       (4**(int($n / 2) + 1)));
 622 #17...........
 623         },
 624
 625         'hanging_side_comments3.def' => {
 626             source => "hanging_side_comments3",
 627             params => "def",
 628             expect => <<'#18...........',
 629     if ( $var eq 'wastebasket' ) {    # this sends a pure block
 630                                       # of hanging side comments
 631                                       #to the vertical aligner.
 632                                       #It caused a crash in
 633                                       #a test version of
 634                                       #sub 'delete_unmatched_tokens'
 635                                       #...
 636                                       #}
 637     }
 638     elsif ( $var eq 'spacecommand' ) {
 639         &die("No $val function") unless eval "defined &$val";
 640     }
 641 #18...........
 642         },
 643
 644         'lop.def' => {
 645             source => "lop",
 646             params => "def",
 647             expect => <<'#19...........',
 648 # logical padding examples
 649 $same =
 650   (      ( $aP eq $bP )
 651       && ( $aS eq $bS )
 652       && ( $aT eq $bT )
 653       && ( $a->{'title'} eq $b->{'title'} )
 654       && ( $a->{'href'} eq $b->{'href'} ) );
 655
 656 $bits =
 657     $top > 0xffff ? 32
 658   : $top > 0xff   ? 16
 659   : $top > 1      ? 8
 660   :                 1;
 661
 662 lc(      $self->mime_attr('content-type')
 663       || $self->{MIH_DefaultType}
 664       || 'text/plain' );
 665
 666 # Padding can also remove spaces; here the space after the '(' is lost:
 667 elsif ($statement_type =~ /^sub\b/
 668     || $paren_type[$paren_depth] =~ /^sub\b/ )
 669 #19...........
 670         },
 671     };
 672
 673     my $ntests = 0 + keys %{$rtests};
 674     plan tests => $ntests;
 675 }
 676
 677 ###############
 678 # EXECUTE TESTS
 679 ###############
 680
 681 foreach my $key ( sort keys %{$rtests} ) {
 682     my $output;
 683     my $sname  = $rtests->{$key}->{source};
 684     my $expect = $rtests->{$key}->{expect};
 685     my $pname  = $rtests->{$key}->{params};
 686     my $source = $rsources->{$sname};
 687     my $params = defined($pname) ? $rparams->{$pname} : "";
 688     my $stderr_string;
 689     my $errorfile_string;
 690     my $err = Perl::Tidy::perltidy(
 691         source      => \$source,
 692         destination => \$output,
 693         perltidyrc  => \$params,
 694         argv        => '',             # for safety; hide any ARGV from perltidy
 695         stderr      => \$stderr_string,
 696         errorfile   => \$errorfile_string,    # not used when -se flag is set
 697     );
 698     if ( $err || $stderr_string || $errorfile_string ) {
 699         print STDERR "Error output received for test '$key'\n";
 700         if ($err) {
 701             print STDERR "An error flag '$err' was returned\n";
 702             ok( !$err );
 703         }
 704         if ($stderr_string) {
 705             print STDERR "---------------------\n";
 706             print STDERR "<<STDERR>>\n$stderr_string\n";
 707             print STDERR "---------------------\n";
 708             ok( !$stderr_string );
 709         }
 710         if ($errorfile_string) {
 711             print STDERR "---------------------\n";
 712             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 713             print STDERR "---------------------\n";
 714             ok( !$errorfile_string );
 715         }
 716     }
 717     else {
 718         if ( !is( $output, $expect, $key ) ) {
 719             my $leno = length($output);
 720             my $lene = length($expect);
 721             if ( $leno == $lene ) {
 722                 print STDERR
 723 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 724             }
 725             else {
 726                 print STDERR
 727 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 728             }
 729         }
 730     }
 731 }