git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/05_utils_pod.t

   1 #!perl
   2
   3 ##############################################################################
   4 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/05_utils_pod.t $
   5 #     $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
   6 #   $Author: clonezone $
   7 # $Revision: 2416 $
   8 ##############################################################################
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw< -no_match_vars >;
  15 use Readonly;
  16 use Carp qw< confess >;
  17
  18 use Test::More tests => 62;
  19
  20 #-----------------------------------------------------------------------------
  21
  22 Readonly::Scalar my $EXCEPTION_MESSAGE_REGEX =>
  23     qr<malformed [ ] name [ ] section>xmsi;
  24
  25 #-----------------------------------------------------------------------------
  26
  27 BEGIN {
  28     use_ok('Perl::Critic::Utils::POD', qw< :all >)
  29         or confess 'No point in continuing.';
  30 }
  31
  32
  33 can_ok('main', 'get_pod_file_for_module');
  34 can_ok('main', 'get_raw_pod_section_from_file');
  35 can_ok('main', 'get_raw_pod_section_from_filehandle');
  36 can_ok('main', 'get_raw_pod_section_from_string');
  37 can_ok('main', 'get_raw_pod_section_for_module');
  38 can_ok('main', 'get_pod_section_from_file');
  39 can_ok('main', 'get_pod_section_from_filehandle');
  40 can_ok('main', 'get_pod_section_from_string');
  41 can_ok('main', 'get_pod_section_for_module');
  42 can_ok('main', 'trim_raw_pod_section');
  43 can_ok('main', 'trim_pod_section');
  44 can_ok('main', 'get_raw_module_abstract_from_file');
  45 can_ok('main', 'get_raw_module_abstract_from_filehandle');
  46 can_ok('main', 'get_raw_module_abstract_from_string');
  47 can_ok('main', 'get_raw_module_abstract_for_module');
  48 can_ok('main', 'get_module_abstract_from_file');
  49 can_ok('main', 'get_module_abstract_from_filehandle');
  50 can_ok('main', 'get_module_abstract_from_string');
  51 can_ok('main', 'get_module_abstract_for_module');
  52
  53
  54 {
  55     my $code = q<my $x = 3;>;
  56
  57     my $pod = get_raw_pod_section_from_string( $code, 'SYNOPSIS' );
  58
  59     is(
  60         $pod,
  61         undef,
  62         qq<get_raw_pod_section_from_string($code, 'SYNOPSIS')>,
  63     );
  64
  65     $pod = get_pod_section_from_string( $code, 'SYNOPSIS' );
  66
  67     is(
  68         $pod,
  69         undef,
  70         qq<get_pod_section_from_string($code, 'SYNOPSIS')>,
  71     );
  72 }
  73
  74
  75 {
  76     my $code = <<'END_CODE';
  77 =pod
  78 END_CODE
  79
  80     my $pod = get_raw_pod_section_from_string( $code, 'SYNOPSIS' );
  81
  82     is(
  83         $pod,
  84         undef,
  85         q<get_raw_pod_section_from_string('=pod', 'SYNOPSIS')>,
  86     );
  87
  88     $pod = get_pod_section_from_string( $code, 'SYNOPSIS' );
  89
  90     is(
  91         $pod,
  92         undef,
  93         q<get_pod_section_from_string('=pod', 'SYNOPSIS')>,
  94     );
  95 }
  96
  97
  98 {
  99     my $code = <<'END_CODE';
 100 =pod
 101
 102 =head1 FOO
 103
 104 Some plain text.
 105
 106 =cut
 107 END_CODE
 108
 109     my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
 110
 111     my $expected = <<'END_EXPECTED';
 112 =head1 FOO
 113
 114 Some plain text.
 115
 116 END_EXPECTED
 117     is(
 118         $pod,
 119         $expected,
 120         q<get_raw_pod_section_from_string('=head1 FOO Some plain text.', 'FOO')>,
 121     );
 122
 123     $pod = get_pod_section_from_string( $code, 'FOO' );
 124
 125     $expected = <<'END_EXPECTED';
 126 FOO
 127     Some plain text.
 128
 129 END_EXPECTED
 130     is(
 131         $pod,
 132         $expected,
 133         q<get_pod_section_from_string('=head1 FOO Some plain text.', 'FOO')>,
 134     );
 135 }
 136
 137
 138 {
 139     my $code = <<'END_CODE';
 140 =pod
 141
 142 =head1 FOO
 143
 144 Some C<escaped> text.
 145
 146 =cut
 147 END_CODE
 148
 149     my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
 150
 151     my $expected = <<'END_EXPECTED';
 152 =head1 FOO
 153
 154 Some C<escaped> text.
 155
 156 END_EXPECTED
 157     is(
 158         $pod,
 159         $expected,
 160         q/get_raw_pod_section_from_string('=head1 FOO Some C<escaped> text.', 'FOO')/,
 161     );
 162
 163     $pod = get_pod_section_from_string( $code, 'FOO' );
 164
 165     $expected = <<'END_EXPECTED';
 166 FOO
 167     Some `escaped' text.
 168
 169 END_EXPECTED
 170     is(
 171         $pod,
 172         $expected,
 173         q/get_pod_section_from_string('=head1 FOO Some C<escaped> text.', 'FOO')/,
 174     );
 175 }
 176
 177
 178 {
 179     my $code = <<'END_CODE';
 180 =pod
 181
 182 =head1 FOO
 183
 184 Some plain text.
 185
 186 =head1 BAR
 187
 188 =cut
 189 END_CODE
 190
 191     my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
 192
 193     my $expected = <<'END_EXPECTED';
 194 =head1 FOO
 195
 196 Some plain text.
 197
 198 END_EXPECTED
 199     is(
 200         $pod,
 201         $expected,
 202         q<get_raw_pod_section_from_string('=head1 FOO ... =head1 BAR', 'FOO')>,
 203     );
 204
 205     $pod = get_pod_section_from_string( $code, 'FOO' );
 206
 207     $expected = <<'END_EXPECTED';
 208 FOO
 209     Some plain text.
 210
 211 END_EXPECTED
 212     is(
 213         $pod,
 214         $expected,
 215         q<get_pod_section_from_string('=head1 FOO ... =head1 BAR', 'FOO')>,
 216     );
 217 }
 218
 219
 220 {
 221     my $code = <<'END_CODE';
 222 =pod
 223
 224 =head1 FOO
 225
 226 Some plain text.
 227
 228 =head2 BAR
 229
 230 =cut
 231 END_CODE
 232
 233     my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
 234
 235     my $expected = <<'END_EXPECTED';
 236 =head1 FOO
 237
 238 Some plain text.
 239
 240 =head2 BAR
 241
 242 END_EXPECTED
 243     is(
 244         $pod,
 245         $expected,
 246         q<get_raw_pod_section_from_string('=head1 FOO ... =head2 BAR', 'FOO')>,
 247     );
 248
 249     $pod = get_pod_section_from_string( $code, 'FOO' );
 250
 251     $expected = <<'END_EXPECTED';
 252 FOO
 253     Some plain text.
 254
 255   BAR
 256
 257 END_EXPECTED
 258     is(
 259         $pod,
 260         $expected,
 261         q<get_pod_section_from_string('=head1 FOO ... =head2 BAR', 'FOO')>,
 262     );
 263 }
 264
 265 {
 266     my $code = <<'END_CODE';
 267 =pod
 268
 269 =head2 FOO
 270
 271 Some plain text.
 272
 273 =cut
 274 END_CODE
 275
 276     my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
 277
 278     is(
 279         $pod,
 280         undef,
 281         q<get_raw_pod_section_from_string('=head2 FOO Some plain text.', 'FOO')>,
 282     );
 283
 284     $pod = get_pod_section_from_string( $code, 'FOO' );
 285
 286     is(
 287         $pod,
 288         undef,
 289         q<get_pod_section_from_string('=head2 FOO Some plain text.', 'FOO')>,
 290     );
 291 }
 292
 293 #-----------------------------------------------------------------------------
 294
 295 {
 296     my $original = <<'END_POD';
 297 =head1 LYRICS
 298
 299 We like talking dirty. We smoke and we drink. We're KMFDM and all other bands
 300 stink.
 301
 302 END_POD
 303
 304     my $trimmed = trim_raw_pod_section( $original );
 305
 306     my $expected =
 307         q<We like talking dirty. We smoke and we drink. >
 308         . qq<We're KMFDM and all other bands\n>
 309         . q<stink.>;
 310
 311     is(
 312         $trimmed,
 313         $expected,
 314         'trim_raw_pod_section() with section header',
 315     );
 316
 317     $trimmed = trim_pod_section( $original );
 318
 319     is(
 320         $trimmed,
 321         $expected,
 322         'trim_pod_section() with section header',
 323     );
 324 }
 325
 326
 327 {
 328     my $original = <<'END_VOCAL_SAMPLE';
 329
 330 You see, I believe in the noble, aristocratic art of doin' absolutely nothin'.
 331 And I hope someday to be in a position where I can do even less.
 332
 333 END_VOCAL_SAMPLE
 334
 335     my $trimmed = trim_raw_pod_section( $original );
 336
 337     my $expected =
 338         q<You see, I believe in the noble, aristocratic art of doin' >
 339         . qq<absolutely nothin'.\n>
 340         . q<And I hope someday to be in a position where I can do even >
 341         . q<less.>;
 342
 343     is(
 344         $trimmed,
 345         $expected,
 346         'trim_raw_pod_section() without section header',
 347     );
 348
 349     $trimmed = trim_pod_section( $original );
 350
 351     is(
 352         $trimmed,
 353         $expected,
 354         'trim_pod_section() without section header',
 355     );
 356 }
 357
 358
 359 {
 360     my $original = <<'END_INDENTATION';
 361
 362     Some indented text.
 363
 364 END_INDENTATION
 365
 366     my $trimmed = trim_raw_pod_section( $original );
 367
 368     my $expected = q<Some indented text.>;
 369
 370     is(
 371         $trimmed,
 372         $expected,
 373         'trim_raw_pod_section() indented',
 374     );
 375
 376     $trimmed = trim_pod_section( $original );
 377
 378     $expected = q<    > . $expected;
 379
 380     is(
 381         $trimmed,
 382         $expected,
 383         'trim_pod_section() indented',
 384     );
 385 }
 386
 387 #-----------------------------------------------------------------------------
 388
 389 {
 390     my $source = <<'END_MODULE';
 391
 392 =head1 NAME
 393
 394 A::Stupendous::Module - An abstract.
 395
 396 END_MODULE
 397
 398     my $expected = q<An abstract.>;
 399
 400     my $result = get_raw_module_abstract_from_string( $source );
 401
 402     is(
 403         $result,
 404         $expected,
 405         q<get_raw_module_abstract_from_string() with proper abstract>,
 406     );
 407
 408     $result = get_module_abstract_from_string( $source );
 409
 410     is(
 411         $result,
 412         $expected,
 413         q<get_module_abstract_from_string() with proper abstract>,
 414     );
 415 }
 416
 417
 418 {
 419     my $source = <<'END_MODULE';
 420
 421 =head1 NAME
 422
 423 A::Stupendous::Code::Module - An abstract involving C<$code>.
 424
 425 END_MODULE
 426
 427     my $expected = q<An abstract involving C<$code>.>;
 428
 429     my $result = get_raw_module_abstract_from_string( $source );
 430
 431     is(
 432         $result,
 433         $expected,
 434         q<get_raw_module_abstract_from_string() with proper abstract>,
 435     );
 436
 437     $expected = q<An abstract involving `$code'.>;
 438
 439     $result = get_module_abstract_from_string( $source );
 440
 441     is(
 442         $result,
 443         $expected,
 444         q<get_module_abstract_from_string() with proper abstract>,
 445     );
 446 }
 447
 448
 449 {
 450     my $source = <<'END_MODULE';
 451
 452 =head1 NOT NAME
 453
 454 There's nobody home.
 455
 456 END_MODULE
 457
 458     my $result = get_raw_module_abstract_from_string( $source );
 459
 460     is(
 461         $result,
 462         undef,
 463         q<get_raw_module_abstract_from_string() with no name section>,
 464     );
 465
 466     $result = get_module_abstract_from_string( $source );
 467
 468     is(
 469         $result,
 470         undef,
 471         q<get_module_abstract_from_string() with no name section>,
 472     );
 473 }
 474
 475
 476 {
 477     my $source = <<'END_MODULE';
 478
 479 =head1 NAME
 480
 481 =head1 DESCRIPTION
 482
 483 END_MODULE
 484
 485     my $result = get_raw_module_abstract_from_string( $source );
 486
 487     is(
 488         $result,
 489         undef,
 490         q<get_raw_module_abstract_from_string() without NAME section content>,
 491     );
 492
 493     $result = get_module_abstract_from_string( $source );
 494
 495     is(
 496         $result,
 497         undef,
 498         q<get_module_abstract_from_string() without NAME section content>,
 499     );
 500 }
 501
 502
 503 {
 504     my $source = <<'END_MODULE';
 505
 506 =head1 NAME
 507
 508 A::Not::So::Stupendous::Module
 509
 510 END_MODULE
 511
 512     my $result = get_raw_module_abstract_from_string( $source );
 513
 514     is(
 515         $result,
 516         undef,
 517         q<get_raw_module_abstract_from_string() with no abstract>,
 518     );
 519
 520     $result = get_module_abstract_from_string( $source );
 521
 522     is(
 523         $result,
 524         undef,
 525         q<get_module_abstract_from_string() with no abstract>,
 526     );
 527 }
 528
 529
 530 {
 531     my $source = <<'END_MODULE';
 532
 533 =head1 NAME
 534
 535 A::Not::So::Stupendous::Module -
 536
 537 END_MODULE
 538
 539     my $result = get_raw_module_abstract_from_string( $source );
 540
 541     is(
 542         $result,
 543         undef,
 544         q<get_raw_module_abstract_from_string() with hyphen but no abstract>,
 545     );
 546
 547     $result = get_module_abstract_from_string( $source );
 548
 549     is(
 550         $result,
 551         undef,
 552         q<get_module_abstract_from_string() with hyphen but no abstract>,
 553     );
 554 }
 555
 556
 557 {
 558     my $source = <<'END_MODULE';
 559
 560 =head1 NAME
 561
 562 A::Not::So::Stupendous::Module No hyphen.
 563
 564 END_MODULE
 565
 566     test_exception_from_get_raw_module_abstract_from_string(
 567         $source, q<with abstract but no hyphen>,
 568     );
 569
 570     test_exception_from_get_module_abstract_from_string(
 571         $source, q<with abstract but no hyphen>,
 572     );
 573 }
 574
 575
 576 {
 577     my $source = <<'END_MODULE';
 578
 579 =head1 NAME
 580
 581 A::Not::So::Stupendous::Module -- Double hyphen.
 582
 583 END_MODULE
 584
 585     test_exception_from_get_raw_module_abstract_from_string(
 586         $source, q<with double hyphen>,
 587     );
 588
 589     test_exception_from_get_module_abstract_from_string(
 590         $source, q<with double hyphen>,
 591     );
 592 }
 593
 594
 595 {
 596     my $source = <<'END_MODULE';
 597
 598 =head1 NAME
 599
 600 A::Not::So::Stupendous::Module - Abstract goes across
 601 multiple lines.
 602
 603 END_MODULE
 604
 605     test_exception_from_get_raw_module_abstract_from_string(
 606         $source, q<with multiple lines>,
 607     );
 608
 609 # Cannot do this test: Pod::PlainText merges the lines.
 610 #    test_exception_from_get_module_abstract_from_string(
 611 #        $source, q<with multiple lines>,
 612 #    );
 613 }
 614
 615 #-----------------------------------------------------------------------------
 616
 617 sub test_exception_from_get_raw_module_abstract_from_string {
 618     my ($source, $name) = @_;
 619
 620     my $result;
 621     my $message_like_name =
 622         qq<Got expected message for get_raw_module_abstract_from_string() $name>;
 623
 624     local $EVAL_ERROR = undef;
 625     eval {
 626         $result = get_raw_module_abstract_from_string( $source );
 627     };
 628     _test_exception_from_get_module_abstract_from_string(
 629         $source, $name, $result, $message_like_name,
 630     );
 631
 632     return;
 633 }
 634
 635 sub test_exception_from_get_module_abstract_from_string {
 636     my ($source, $name) = @_;
 637
 638     my $result;
 639     my $message_like_name =
 640         qq<Got expected message for get_module_abstract_from_string() $name>;
 641
 642     local $EVAL_ERROR = undef;
 643     eval {
 644         $result = get_module_abstract_from_string( $source );
 645     };
 646     _test_exception_from_get_module_abstract_from_string(
 647         $source, $name, $result, $message_like_name,
 648     );
 649
 650     return;
 651 }
 652
 653 sub _test_exception_from_get_module_abstract_from_string {
 654     my ($source, $name, $result, $message_like_name) = @_;
 655
 656     my $eval_error = $EVAL_ERROR;
 657     my $exception = Perl::Critic::Exception::Fatal::Generic->caught();
 658
 659     if (
 660         ok(
 661             ref $exception,
 662             qq<Got the right kind of exception for get_module_abstract_from_string() $name>,
 663         )
 664     ) {
 665         like( $exception->message(), $EXCEPTION_MESSAGE_REGEX, $message_like_name );
 666     }
 667     else {
 668         diag( 'Result: ', (defined $result ? ">$result<" : '<undef>') );
 669         if ($eval_error) {
 670             diag(
 671                 qq<However, did get an exception: $eval_error>,
 672             );
 673             like( $eval_error, $EXCEPTION_MESSAGE_REGEX, $message_like_name );
 674         }
 675         else {
 676             fail($message_like_name);
 677         }
 678     }
 679
 680     return;
 681 }
 682
 683 #-----------------------------------------------------------------------------
 684
 685 # ensure we run true if this test is loaded by
 686 # t/05_utils_pod.t_without_optional_dependencies.t
 687 1;
 688
 689 # Local Variables:
 690 #   mode: cperl
 691 #   cperl-indent-level: 4
 692 #   fill-column: 78
 693 #   indent-tabs-mode: nil
 694 #   c-indentation-style: bsd
 695 # End:
 696 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :