t/perl/Parrot_Docs.t

   1 #! perl
   2 # Copyright (C) 2001-2005, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More 'tests' => 25;
   9 use File::Spec::Functions qw(:ALL);
  10
  11 =head1 NAME
  12
  13 t/perl/Parrot_Docs.t - Parrot::Docs unit tests
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/perl/Parrot_Docs.t
  18
  19 =head1 DESCRIPTION
  20
  21 These tests cover the basic functionality of the C<Parrot::Docs>
  22 modules: file types, POD syntax checking, and to-HTML formatting.
  23
  24 When one or more of the C<Parrot::Docs> modules is modified, run the tests
  25 to ensure nothing is broken.
  26
  27 =cut
  28
  29 BEGIN { use_ok("Parrot::Docs::POD2HTML") }
  30
  31 ok(
  32     Parrot::Docs::POD2HTML->href_path('docs\pdds\pdd00_pdd.pod.html') eq
  33         'docs/pdds/pdd00_pdd.pod.html',
  34     'href_path'
  35 );
  36
  37 BEGIN { use_ok('Parrot::Docs::Directory') }
  38 BEGIN { use_ok('Parrot::Docs::File') }
  39
  40 teardown();
  41
  42 my $d = Parrot::Docs::Directory->new( catfile(qw(lib Parrot Docs)) );
  43 my @a = $d->files_of_type('Perl module');
  44
  45 # This will fail if you add a new module.
  46 is( @a, 8, 'files_of_type succeed' );
  47 @a = $d->files_of_type('foo');
  48 is( @a, 0, 'files_of_type fail' );
  49
  50 my $f = $d->file_with_name('File.pm');
  51 ok( $f->is_of_type('Perl module'), 'is_of_type succeed' );
  52 ok( !$f->is_of_type('foo'), 'is_of_type fail' );
  53 is( $f->short_description, 'Docs-Related File', 'short_description' );
  54
  55 $f = Parrot::Docs::File->new( tmp_file_path('file.pod') );
  56 $f->write("foo");
  57 ok( !$f->contains_pod, 'contains_pod no' );
  58 $f->write("=head1 FOO\n\nFoo\n\n=cut\n\nbar\n");
  59 ok( $f->contains_pod, 'contains_pod yes, no errors' );
  60 is( $f->num_pod_errors, 0, 'num_pod_errors none' );
  61
  62 # Not the best of tests, but at least something.
  63 like( $f->pod_as_html, qr|<html.*?</html>|si, 'pod_as_html' );
  64 $f->write("=haed1 FOO\n\nFoo\n\n=cut\n\nbar\n");
  65 ok( $f->contains_pod, 'contains_pod yes, errors' );
  66 is( $f->num_pod_errors, 1, 'num_pod_errors one' );
  67 like( $f->pod_errors, qr/error/s, 'pod_errors' );
  68
  69 # Now the structural classes.
  70 BEGIN { use_ok('Parrot::Docs::Item') }
  71 BEGIN { use_ok('Parrot::Docs::Group') }
  72 BEGIN { use_ok('Parrot::Docs::Section') }
  73
  74 my $src = Parrot::Docs::Directory->new( tmp_dir_path('src') );
  75 $d = $src->directory_with_name('foo');
  76 $f = $d->file_with_name('file1.pod');
  77 $f->write("=head1 NAME\n\nxyz - foo/file1.pod\n\n=cut\n");
  78 $f = $d->file_with_name('file2.pod');
  79 $f->write("=head1 NAME\n\nxyz - foo/file1.pod\n\n=cut\n");
  80 $d = $src->directory_with_name('bar');
  81 $f = $d->file_with_name('file3.pod');
  82 $f->write("=head1 NAME\n\nxyz - bar/file3.pod\n\n=cut\n");
  83 $f = $src->file_with_name('file.txt');
  84 $f->write("file.txt");
  85 $d = $src->directory_with_name('pub');
  86 $f = $d->file_with_name('beer.pint');
  87
  88 my $i = Parrot::Docs::Item->new( 'Usual suspects', 'foo', 'bar' );
  89 ok( $i, 'new item' );
  90
  91 my $g = Parrot::Docs::Group->new(
  92     'Usual suspects',
  93     '',
  94     Parrot::Docs::Item->new( '', 'foo' ),
  95     Parrot::Docs::Item->new( '', 'bar' )
  96 );
  97
  98 ok( $g, 'new group' );
  99 is( $g->name, 'Usual suspects', 'name' );
 100
 101 my $s = Parrot::Docs::Section->new(
 102     'Usual Suspects',
 103     'index.html',
 104     'here they are...',
 105     Parrot::Docs::Item->new( 'our old friend', 'foo' ),
 106     Parrot::Docs::Group->new(
 107         'Bar', 'no jeans', Parrot::Docs::Item->new( 'time please', 'bar', 'pub' )
 108         )
 109 );
 110
 111 ok( $s, 'new section' );
 112
 113 my $tgt = Parrot::Docs::Directory->new( tmp_dir_path('tgt') );
 114
 115 $s->write_html( $src, $tgt, 1 );
 116
 117 $f = $tgt->file_with_name('index.html');
 118
 119 ok( $f, 'index.html' );
 120
 121 my $html = $f->read;
 122
 123 ok(
 124     $html        =~ m|Usual Suspects|s
 125 #        && $html =~ m|here they are|s
 126         && $html =~ m|foo/file1.pod|s
 127         && $html =~ m|foo/file2.pod|s
 128         && $html =~ m|Bar|s
 129 #        && $html =~ m|no jeans|s
 130         && $html =~ m|bar/file3.pod|s
 131         && $html =~ m|time please|s,
 132     'write_html'
 133 );
 134
 135 teardown();
 136
 137 sub teardown {
 138     Parrot::Docs::File->new( tmp_file_path('file.pod') )->delete();
 139     Parrot::Docs::Directory->new( tmp_dir_path('src') )->delete();
 140     Parrot::Docs::Directory->new( tmp_dir_path('tgt') )->delete();
 141 }
 142
 143 # tmp_dir_path(@dirs)
 144 sub tmp_dir_path {
 145     return catdir( tmpdir, @_ );
 146 }
 147
 148 # tmp_file_path(@dirs, $file)
 149 sub tmp_file_path {
 150     my $file;
 151
 152     if ( @_ == 1 ) {
 153         $file = catfile( tmp_dir_path(), shift );
 154     }
 155     else {
 156         $file = pop(@_);
 157         $file = catfile( tmp_dir_path(@_), $file );
 158     }
 159
 160     return $file;
 161 }
 162
 163 # Local Variables:
 164 #   mode: cperl
 165 #   cperl-indent-level: 4
 166 #   fill-column: 100
 167 # End:
 168 # vim: expandtab shiftwidth=4: