t/tools/smartlinks.t

   1 #! perl
   2 # Copyright (C) 2006-2008, The Perl Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/tools/smartlinks.t - test the smartlink generator
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/tools/smartlinks.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests L<SmartLink> and the F<tools/util/smartlinks.pl> utility
  16 by exercising different options, processing example test files
  17 and spec documents, and examining the output.
  18
  19 We never actually check the I<full> output of the utility.
  20 We simply check several smaller components to avoid a test file
  21 that is far too unwieldy.
  22
  23 =cut
  24
  25 use strict;
  26 use warnings;
  27 use lib qw( . lib ../lib ../../lib );
  28
  29 use File::Temp qw( tempdir tempfile );
  30 use Parrot::Test;
  31 use Test::More;
  32
  33 BEGIN {
  34     eval { require Moose };
  35     plan $@
  36         ? (skip_all => 'Moose not installed')
  37         : (tests => 73);
  38 }
  39
  40 BEGIN {
  41     use_ok 'SmartLink' or die;
  42 }
  43
  44 sub vdiag(@) { &diag if $ENV{TEST_VERBOSE} }
  45
  46 {
  47     vdiag 'SmartLink: multiple keyphrases';
  48     my $link = q{L<S05/bar/baz quux>};
  49
  50     eval { my $l = SmartLink->new; };
  51     like( $@, '/^Attribute \(.*? is required/', '->new requires one or more attributes' );
  52
  53     my $l = SmartLink->new( link => $link );
  54
  55     isa_ok( $l, 'SmartLink' );
  56     is( $l->link, $link, '->link returns full link text' );
  57     is( $l->section, 'bar', '->section returns document section' );
  58     ok( $l->has_keyphrases, '->has_keyphrases returns true' );
  59
  60     vdiag 'SmartLink->Keyphrase';
  61     my $k = $l->keyphrases;
  62     ok( $l->has_keyphrases, '->has_keyphrases returns true' );
  63     isa_ok( $k, 'Keyphrase' );
  64     is( $k->string, 'baz quux', '->string returns keyphrase string' );
  65     is_deeply( $k->list, [qw/baz quux/], '->list returns arrayref of keyphrases' );
  66     is( $k->regex, '\bbaz\b.+?\bquux\b', '->regex returns regex' );
  67
  68     vdiag 'SmartLink->Doc';
  69     my $d = $l->doc;
  70     isa_ok( $d, 'Doc' );
  71     is( $d->id,     'S05', '->id returns document identifier' );
  72     is( $d->prefix, 'S',   '->prefix returns document prefix' );
  73     is( $d->num,    '05',  '->num returns document number' );
  74
  75     vdiag 'SmartLink: invalid format';
  76     $link = q{L<S05/bar/>};
  77     eval { my $l = SmartLink->new( link => $link ); };
  78     like(
  79         $@,
  80         '/^Attribute \(link\) does not pass the type constraint(?: because: Validation failed for)? [(\']PodLink[\')]/',
  81         '->new fails with malformed smartlink'
  82     );
  83
  84     vdiag 'SmartLink: complex keyphrases';
  85     $link = q{L<S05/bar/a b 'c d e' f g "h'i j" k>};
  86     $l = SmartLink->new( link => $link );
  87
  88     isa_ok( $l, 'SmartLink' );
  89     is( $l->link, $link, '->link returns full link text' );
  90     is( $l->section, 'bar', '->section returns document section' );
  91     ok( $l->has_keyphrases, '->has_keyphrases returns true' );
  92
  93     vdiag 'SmartLink->Keyphrase';
  94     $k = $l->keyphrases;
  95     ok( $l->has_keyphrases, '->has_keyphrases returns true' );
  96     isa_ok( $k, 'Keyphrase' );
  97     is( $k->string, q{a b 'c d e' f g "h'i j" k}, '->string returns keyphrase string' );
  98     is_deeply(
  99         $k->list,
 100         [ 'a', 'b', 'c d e', 'f', 'g', "h'i j", 'k' ],
 101         '->list returns arrayref of keyphrases'
 102     );
 103     is(
 104         $k->regex,
 105         q{\ba\b.+?\bb\b.+?\bc\ d\ e\b.+?\bf\b.+?\bg\b.+?\bh\'i\ j\b.+?\bk\b},
 106         '->regex returns regex'
 107     );
 108
 109     vdiag 'SmartLink->Doc';
 110     $d = $l->doc;
 111     isa_ok( $d, 'Doc' );
 112     is( $d->id,     'S05', '->doc returns document identifier' );
 113     is( $d->prefix, 'S',   '->docprefix returns document prefix' );
 114     is( $d->num,    '05',  '->docnum returns document number' );
 115
 116     vdiag 'SmartLink: no keyphrases';
 117     $link = q{L<S05/bar>};
 118     $l = SmartLink->new( link => $link );
 119
 120     isa_ok( $l, 'SmartLink' );
 121     is( $l->link, $link, '->link returns full link text' );
 122     is( $l->section, 'bar', '->section returns document section' );
 123     ok( !$l->has_keyphrases, '->has_keyphrases returns false' );
 124     is( $l->keyphrases, undef, '->keyphrases returns undef' );
 125 }
 126
 127 {
 128     vdiag 'File';
 129     my ( $fh, $fn ) = tempfile( UNLINK => 1 );
 130     print $fh 'i am a file' and close $fh;
 131     my $f = File->new( filename => $fn );
 132     isa_ok( $f, 'File' );
 133
 134     $fh = $f->open( '<' );
 135     is( $fh, $f->filehandle, 'open returns a filehandle' );
 136     is( $f->mode, '<', 'open mode' );
 137     is( scalar <$fh>, 'i am a file', 'read' );
 138     $f->close;
 139     {
 140         local $TODO = 'filehandle after close';
 141         is( $f->filehandle, undef, 'filehandle after close' );
 142     }
 143
 144     my $no_such = File->new( filename => 'no_such.txt' );
 145     ok( $no_such, 'ok to instantiate a non-existent file' );
 146     eval { $no_such->open( '<' ); };
 147     like( $@, '/can\'t open/i', 'fail to open non-existent file' );
 148 }
 149
 150 {
 151
 152     vdiag 'PodFile';
 153     my $fn = 'docs/pdds/pdd03_calling_conventions.pod';
 154
 155     eval { my $p = PodFile->new; };
 156     like( $@, '/^Attribute \(.*?\) is required/', '->new requires one or more attributes' );
 157
 158     my $p = PodFile->new( filename => $fn );
 159
 160     isa_ok( $p, 'PodFile' );
 161     is( $p->filename,  $fn,                         '->filename returns given filename' );
 162     is( $p->name,      'pdd03_calling_conventions', '->name returns file basename' );
 163     is( $p->path,      'docs/pdds/',                '->path returns file path' );
 164     is( $p->extension, '.pod',                      '->extension returns C<.pod>' );
 165
 166     my $tree = $p->parse;
 167     ok( $tree, 'parsed' );
 168
 169     # RT #46787: ->tree
 170 }
 171
 172 {
 173
 174     vdiag 'SpecFile';
 175     my $fn  = 'docs/pdds/pdd03_calling_conventions.pod';
 176     my $pre = 'pdd';
 177
 178     eval { my $s = SpecFile->new; };
 179     like( $@, '/^Attribute \(.*?\) is required/', '->new requires one or more attributes' );
 180
 181     my $s = SpecFile->new( filename => $fn, prefix => $pre );
 182
 183     isa_ok( $s, 'SpecFile' );
 184     is( $s->name,      'pdd03_calling_conventions', '->name returns file basename' );
 185     is( $s->path,      'docs/pdds/',                '->path returns file path' );
 186     is( $s->extension, '.pod',                      '->extension returns C<.pod>' );
 187     is( $s->num,       '03',                        '->num returns spec number' );
 188
 189     $s = SpecFile->new( filename => '3.pod', prefix => '' );
 190     is( $s->name,   '3', '->name returns "3"' );
 191     is( $s->prefix, '',  '->prefix returns empty string' );
 192     is( $s->num,    '3', '->num returns spec number' );
 193
 194     $s = SpecFile->new( filename => 'S.pod', prefix => 'S' );
 195     is( $s->name,   'S', '->name returns "S"' );
 196     is( $s->prefix, 'S', '->prefix returns "S"' );
 197     is( $s->num,    '',  '->num returns empty string' );
 198 }
 199
 200 {
 201
 202     vdiag 'SpecFiles';
 203     my $root = 'docs/pdds/';
 204     my $pre  = 'pdd';
 205
 206     eval { my $s = SpecFiles->new; };
 207     like( $@, '/^Attribute \(.*?\) is required/', '->new requires one or more attributes' );
 208
 209     my $s = SpecFiles->new( prefix => $pre, root => $root );
 210
 211     isa_ok( $s, 'SpecFiles' );
 212     is( $s->root,      $root,   '->root returns spec file directory' );
 213     is( $s->extension, '.pod',  '->extension returns file extension' );
 214     is( $s->prefix,    $pre,    '->prefix returns spec file prefix' );
 215     is( ref $s->files, 'ARRAY', '->files is an array reference' );
 216
 217     ok( ( grep { $_->name eq 'pdd07_codingstd' } @{ $s->files } ),
 218         '->files contains a known spec file' );
 219
 220     # RT #46789: many more ->files tests
 221 }
 222
 223 {
 224
 225     vdiag 'TestFile';
 226     my $fn = 't/util/smartlinks.t';
 227
 228     eval { my $t = TestFile->new; };
 229     like( $@, '/^Attribute \(.*?\) is required/', '->new requires one or more attributes' );
 230
 231     my $t = TestFile->new( filename => $fn );
 232
 233     isa_ok( $t, 'TestFile' );
 234     is( $t->filename,  $fn,          '->filename returns given filename' );
 235     is( $t->name,      'smartlinks', '->name returns file basename' );
 236     is( $t->path,      't/util/',    '->path returns file path' );
 237     is( $t->extension, '.t',         '->extension returns C<.pod>' );
 238
 239     # RT #46791: ->tests, ->smartlinks
 240 }
 241
 242 # RT #46793: Test
 243 # RT #46795: TestInfo
 244 # RT #46797: SmartLinkServer
 245 # RT #46801: main
 246 # RT #46799: end-to-end testing
 247
 248 # Local Variables:
 249 #   mode: cperl
 250 #   cperl-indent-level: 4
 251 #   fill-column: 100
 252 # End:
 253 # vim: expandtab shiftwidth=4: