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) $
8 ##############################################################################
14 use English qw< -no_match_vars >;
16 use Carp qw< confess >;
18 use Test::More tests => 62;
20 #-----------------------------------------------------------------------------
22 Readonly::Scalar my $EXCEPTION_MESSAGE_REGEX =>
23 qr<malformed [ ] name [ ] section>xmsi;
25 #-----------------------------------------------------------------------------
28 use_ok('Perl::Critic::Utils::POD', qw< :all >)
29 or confess 'No point in continuing.';
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');
55 my $code = q<my $x = 3;>;
57 my $pod = get_raw_pod_section_from_string( $code, 'SYNOPSIS' );
62 qq<get_raw_pod_section_from_string($code, 'SYNOPSIS')>,
65 $pod = get_pod_section_from_string( $code, 'SYNOPSIS' );
70 qq<get_pod_section_from_string($code, 'SYNOPSIS')>,
76 my $code = <<'END_CODE';
80 my $pod = get_raw_pod_section_from_string( $code, 'SYNOPSIS' );
85 q<get_raw_pod_section_from_string('=pod', 'SYNOPSIS')>,
88 $pod = get_pod_section_from_string( $code, 'SYNOPSIS' );
93 q<get_pod_section_from_string('=pod', 'SYNOPSIS')>,
99 my $code = <<'END_CODE';
109 my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
111 my $expected = <<'END_EXPECTED';
120 q<get_raw_pod_section_from_string('=head1 FOO Some plain text.', 'FOO')>,
123 $pod = get_pod_section_from_string( $code, 'FOO' );
125 $expected = <<'END_EXPECTED';
133 q<get_pod_section_from_string('=head1 FOO Some plain text.', 'FOO')>,
139 my $code = <<'END_CODE';
144 Some C<escaped> text.
149 my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
151 my $expected = <<'END_EXPECTED';
154 Some C<escaped> text.
160 q/get_raw_pod_section_from_string('=head1 FOO Some C<escaped> text.', 'FOO')/,
163 $pod = get_pod_section_from_string( $code, 'FOO' );
165 $expected = <<'END_EXPECTED';
173 q/get_pod_section_from_string('=head1 FOO Some C<escaped> text.', 'FOO')/,
179 my $code = <<'END_CODE';
191 my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
193 my $expected = <<'END_EXPECTED';
202 q<get_raw_pod_section_from_string('=head1 FOO ... =head1 BAR', 'FOO')>,
205 $pod = get_pod_section_from_string( $code, 'FOO' );
207 $expected = <<'END_EXPECTED';
215 q<get_pod_section_from_string('=head1 FOO ... =head1 BAR', 'FOO')>,
221 my $code = <<'END_CODE';
233 my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
235 my $expected = <<'END_EXPECTED';
246 q<get_raw_pod_section_from_string('=head1 FOO ... =head2 BAR', 'FOO')>,
249 $pod = get_pod_section_from_string( $code, 'FOO' );
251 $expected = <<'END_EXPECTED';
261 q<get_pod_section_from_string('=head1 FOO ... =head2 BAR', 'FOO')>,
266 my $code = <<'END_CODE';
276 my $pod = get_raw_pod_section_from_string( $code, 'FOO' );
281 q<get_raw_pod_section_from_string('=head2 FOO Some plain text.', 'FOO')>,
284 $pod = get_pod_section_from_string( $code, 'FOO' );
289 q<get_pod_section_from_string('=head2 FOO Some plain text.', 'FOO')>,
293 #-----------------------------------------------------------------------------
296 my $original = <<'END_POD';
299 We like talking dirty. We smoke and we drink. We're KMFDM and all other bands
304 my $trimmed = trim_raw_pod_section( $original );
307 q<We like talking dirty. We smoke and we drink. >
308 . qq<We're KMFDM and all other bands\n>
314 'trim_raw_pod_section() with section header',
317 $trimmed = trim_pod_section( $original );
322 'trim_pod_section() with section header',
328 my $original = <<'END_VOCAL_SAMPLE';
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.
335 my $trimmed = trim_raw_pod_section( $original );
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 >
346 'trim_raw_pod_section() without section header',
349 $trimmed = trim_pod_section( $original );
354 'trim_pod_section() without section header',
360 my $original = <<'END_INDENTATION';
366 my $trimmed = trim_raw_pod_section( $original );
368 my $expected = q<Some indented text.>;
373 'trim_raw_pod_section() indented',
376 $trimmed = trim_pod_section( $original );
378 $expected = q< > . $expected;
383 'trim_pod_section() indented',
387 #-----------------------------------------------------------------------------
390 my $source = <<'END_MODULE';
394 A::Stupendous::Module - An abstract.
398 my $expected = q<An abstract.>;
400 my $result = get_raw_module_abstract_from_string( $source );
405 q<get_raw_module_abstract_from_string() with proper abstract>,
408 $result = get_module_abstract_from_string( $source );
413 q<get_module_abstract_from_string() with proper abstract>,
419 my $source = <<'END_MODULE';
423 A::Stupendous::Code::Module - An abstract involving C<$code>.
427 my $expected = q<An abstract involving C<$code>.>;
429 my $result = get_raw_module_abstract_from_string( $source );
434 q<get_raw_module_abstract_from_string() with proper abstract>,
437 $expected = q<An abstract involving `$code'.>;
439 $result = get_module_abstract_from_string( $source );
444 q<get_module_abstract_from_string() with proper abstract>,
450 my $source = <<'END_MODULE';
458 my $result = get_raw_module_abstract_from_string( $source );
463 q<get_raw_module_abstract_from_string() with no name section>,
466 $result = get_module_abstract_from_string( $source );
471 q<get_module_abstract_from_string() with no name section>,
477 my $source = <<'END_MODULE';
485 my $result = get_raw_module_abstract_from_string( $source );
490 q<get_raw_module_abstract_from_string() without NAME section content>,
493 $result = get_module_abstract_from_string( $source );
498 q<get_module_abstract_from_string() without NAME section content>,
504 my $source = <<'END_MODULE';
508 A::Not::So::Stupendous::Module
512 my $result = get_raw_module_abstract_from_string( $source );
517 q<get_raw_module_abstract_from_string() with no abstract>,
520 $result = get_module_abstract_from_string( $source );
525 q<get_module_abstract_from_string() with no abstract>,
531 my $source = <<'END_MODULE';
535 A::Not::So::Stupendous::Module -
539 my $result = get_raw_module_abstract_from_string( $source );
544 q<get_raw_module_abstract_from_string() with hyphen but no abstract>,
547 $result = get_module_abstract_from_string( $source );
552 q<get_module_abstract_from_string() with hyphen but no abstract>,
558 my $source = <<'END_MODULE';
562 A::Not::So::Stupendous::Module No hyphen.
566 test_exception_from_get_raw_module_abstract_from_string(
567 $source, q<with abstract but no hyphen>,
570 test_exception_from_get_module_abstract_from_string(
571 $source, q<with abstract but no hyphen>,
577 my $source = <<'END_MODULE';
581 A::Not::So::Stupendous::Module -- Double hyphen.
585 test_exception_from_get_raw_module_abstract_from_string(
586 $source, q<with double hyphen>,
589 test_exception_from_get_module_abstract_from_string(
590 $source, q<with double hyphen>,
596 my $source = <<'END_MODULE';
600 A::Not::So::Stupendous::Module - Abstract goes across
605 test_exception_from_get_raw_module_abstract_from_string(
606 $source, q<with multiple lines>,
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>,
615 #-----------------------------------------------------------------------------
617 sub test_exception_from_get_raw_module_abstract_from_string {
618 my ($source, $name) = @_;
621 my $message_like_name =
622 qq<Got expected message for get_raw_module_abstract_from_string() $name>;
624 local $EVAL_ERROR = undef;
626 $result = get_raw_module_abstract_from_string( $source );
628 _test_exception_from_get_module_abstract_from_string(
629 $source, $name, $result, $message_like_name,
635 sub test_exception_from_get_module_abstract_from_string {
636 my ($source, $name) = @_;
639 my $message_like_name =
640 qq<Got expected message for get_module_abstract_from_string() $name>;
642 local $EVAL_ERROR = undef;
644 $result = get_module_abstract_from_string( $source );
646 _test_exception_from_get_module_abstract_from_string(
647 $source, $name, $result, $message_like_name,
653 sub _test_exception_from_get_module_abstract_from_string {
654 my ($source, $name, $result, $message_like_name) = @_;
656 my $eval_error = $EVAL_ERROR;
657 my $exception = Perl::Critic::Exception::Fatal::Generic->caught();
662 qq<Got the right kind of exception for get_module_abstract_from_string() $name>,
665 like( $exception->message(), $EXCEPTION_MESSAGE_REGEX, $message_like_name );
668 diag( 'Result: ', (defined $result ? ">$result<" : '<undef>') );
671 qq<However, did get an exception: $eval_error>,
673 like( $eval_error, $EXCEPTION_MESSAGE_REGEX, $message_like_name );
676 fail($message_like_name);
683 #-----------------------------------------------------------------------------
685 # ensure we run true if this test is loaded by
686 # t/05_utils_pod.t_without_optional_dependencies.t
691 # cperl-indent-level: 4
693 # indent-tabs-mode: nil
694 # c-indentation-style: bsd
696 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :