1N/A#!/usr/bin/perl -w
1N/A# $Id: parselink.t,v 1.1 2001/11/23 10:09:06 eagle Exp $
1N/A#
1N/A# parselink.t -- Tests for Pod::ParseLink.
1N/A#
1N/A# Copyright 2001 by Russ Allbery <rra@stanford.edu>
1N/A#
1N/A# This program is free software; you may redistribute it and/or modify it
1N/A# under the same terms as Perl itself.
1N/A
1N/A# The format of each entry in this array is the L<> text followed by the
1N/A# five-element parse returned by parselink. When adding a new test, also
1N/A# increment the test count in the BEGIN block below. We don't use any of the
1N/A# fancy test modules intentionally for backward compatibility to older
1N/A# versions of Perl.
1N/A@TESTS = (
1N/A [ 'foo',
1N/A undef, 'foo', 'foo', undef, 'pod' ],
1N/A
1N/A [ 'foo|bar',
1N/A 'foo', 'foo', 'bar', undef, 'pod' ],
1N/A
1N/A [ 'foo/bar',
1N/A undef, '"bar" in foo', 'foo', 'bar', 'pod' ],
1N/A
1N/A [ 'foo/"baz boo"',
1N/A undef, '"baz boo" in foo', 'foo', 'baz boo', 'pod' ],
1N/A
1N/A [ '/bar',
1N/A undef, '"bar"', undef, 'bar', 'pod' ],
1N/A
1N/A [ '/"baz boo"',
1N/A undef, '"baz boo"', undef, 'baz boo', 'pod' ],
1N/A
1N/A [ '/baz boo',
1N/A undef, '"baz boo"', undef, 'baz boo', 'pod' ],
1N/A
1N/A [ 'foo bar/baz boo',
1N/A undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ],
1N/A
1N/A [ 'foo bar / baz boo',
1N/A undef, '"baz boo" in foo bar', 'foo bar', 'baz boo', 'pod' ],
1N/A
1N/A [ "foo\nbar\nbaz\n/\nboo",
1N/A undef, '"boo" in foo bar baz', 'foo bar baz', 'boo', 'pod' ],
1N/A
1N/A [ 'anchor|name/section',
1N/A 'anchor', 'anchor', 'name', 'section', 'pod' ],
1N/A
1N/A [ '"boo var baz"',
1N/A undef, '"boo var baz"', undef, 'boo var baz', 'pod' ],
1N/A
1N/A [ 'bar baz',
1N/A undef, '"bar baz"', undef, 'bar baz', 'pod' ],
1N/A
1N/A [ '"boo bar baz / baz boo"',
1N/A undef, '"boo bar baz / baz boo"', undef, 'boo bar baz / baz boo',
1N/A 'pod' ],
1N/A
1N/A [ 'fooZ<>bar',
1N/A undef, 'fooZ<>bar', 'fooZ<>bar', undef, 'pod' ],
1N/A
1N/A [ 'Testing I<italics>|foo/bar',
1N/A 'Testing I<italics>', 'Testing I<italics>', 'foo', 'bar', 'pod' ],
1N/A
1N/A [ 'foo/I<Italic> text',
1N/A undef, '"I<Italic> text" in foo', 'foo', 'I<Italic> text', 'pod' ],
1N/A
1N/A [ 'fooE<verbar>barZ<>/Section C<with> I<B<other> markup',
1N/A undef, '"Section C<with> I<B<other> markup" in fooE<verbar>barZ<>',
1N/A 'fooE<verbar>barZ<>', 'Section C<with> I<B<other> markup', 'pod' ],
1N/A
1N/A [ 'Nested L<http://www.perl.org/>|fooE<sol>bar',
1N/A 'Nested L<http://www.perl.org/>', 'Nested L<http://www.perl.org/>',
1N/A 'fooE<sol>bar', undef, 'pod' ],
1N/A
1N/A [ 'ls(1)',
1N/A undef, 'ls(1)', 'ls(1)', undef, 'man' ],
1N/A
1N/A [ ' perlfunc(1)/open ',
1N/A undef, '"open" in perlfunc(1)', 'perlfunc(1)', 'open', 'man' ],
1N/A
1N/A [ 'some manual page|perl(1)',
1N/A 'some manual page', 'some manual page', 'perl(1)', undef, 'man' ],
1N/A
1N/A [ 'http://www.perl.org/',
1N/A undef, 'http://www.perl.org/', 'http://www.perl.org/', undef, 'url' ],
1N/A
1N/A [ 'news:yld72axzc8.fsf@windlord.stanford.edu',
1N/A undef, 'news:yld72axzc8.fsf@windlord.stanford.edu',
1N/A 'news:yld72axzc8.fsf@windlord.stanford.edu', undef, 'url' ]
1N/A);
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A unshift (@INC, '../blib/lib');
1N/A $| = 1;
1N/A print "1..25\n";
1N/A}
1N/A
1N/AEND {
1N/A print "not ok 1\n" unless $loaded;
1N/A}
1N/A
1N/Ause Pod::ParseLink;
1N/A$loaded = 1;
1N/Aprint "ok 1\n";
1N/A
1N/A# Used for reporting test failures.
1N/Amy @names = qw(text inferred name section type);
1N/A
1N/Amy $n = 2;
1N/Afor (@TESTS) {
1N/A my @expected = @$_;
1N/A my $link = shift @expected;
1N/A my @results = parselink ($link);
1N/A my $okay = 1;
1N/A for (0..4) {
1N/A # Make sure to check undef explicitly; we don't want undef to match
1N/A # the empty string because they're semantically different.
1N/A unless ((!defined ($results[$_]) && !defined ($expected[$_]))
1N/A || (defined ($results[$_]) && defined ($expected[$_])
1N/A && $results[$_] eq $expected[$_])) {
1N/A print "not ok $n\n" if $okay;
1N/A print "# Incorrect $names[$_]:\n";
1N/A print "# expected: $expected[$_]\n";
1N/A print "# seen: $results[$_]\n";
1N/A $okay = 0;
1N/A }
1N/A }
1N/A print "ok $n\n" if $okay;
1N/A $n++;
1N/A}