Test/Test.pm

Go to the documentation of this file.

package Doxygen::Test;

=head1 NAME

Doxygen::Test - Test module, used only in Doxygen:: test files (.t files).

=head1 SYNOPSIS

    use Doxygen::Test   path  => 'Filter.pm',
                        tests => 2;
    
    hasComment('\file Test.pm');
    hasMacro;
    
=head1 DESCRIPTION

This module exists only to support automated testing of the other
C<Doxygen> modules.
It is used inside of C<t.#> files instead of C<Test::Simple> or
C<Test::More>.

In addition to specifying the number of tests,
instantiation specifies a source file to be processed.
This is done using the normal C<Doxygen::Source> mechanism.
The output is captured and stored in the object,
so that subsequent C<like()> calls can match against it.

=head1 METHODS

=over

=cut

use 5.005;  # just to pick something, but not really tested
use strict;
use warnings;
use UNIVERSAL   qw(isa);

use File::Basename;
use Test::Builder;

use Doxygen::Source;

use constant TEST_FLAGS => qw(
    path
);

require Exporter;

our @ISA     = qw(Exporter);
our @EXPORT  = qw(
    ok like contains
    hasComment hasMacro includes nameSpace
    dumpGeneratedText);
our $VERSION = '0.01';

our $global;

###########################################################################
###########################################################################

=item   C<new($class, %flags)>

Create new C<Doxygen::Text> item.  Not called directly, a global object
is instantiated via the C<import()> function.

=cut

sub new
{
    my ($class, %flags) = @_;
    my  $self = bless {
        builder =>  Test::Builder->new,
        ok      =>  0,
        failed  =>  0,
        map { $flags{$_} ? ( $_ => $flags{$_} ) : ( ) } TEST_FLAGS
    }, $class;
    
    return $self
        unless $self->{ok} = isa $self->{builder}, 'Test::Builder';
    
    delete $flags{$_}
        for TEST_FLAGS;
    
    $flags{tests} += 3
        if defined $flags{tests};
    
    $self->{builder}->plan(%flags);
    
    $self->{path} = '<noPath>'
        unless $self->{path};
    
    # test #1
    $self->{builder}->ok($self->{ok} = -f $self->{path}, $self->{path});
    
    return $self
        unless $self->{ok};
    
    $self->{source} = new Doxygen::Source(path => $self->{path}, info => 0, stats => 0);
    $self->{builder}->ok( # test #2
        $self->{ok} = isa($self->{source}, 'Doxygen::Source'),
        "create Doxygen::Source object");
    
    return $self
        unless $self->{ok};
    
    my  $string;
    
    open  TMPOUT, ">&STDOUT";
    close STDOUT;
    open  STDOUT, '>', \$string or die "*** Boo hoo!\n";
    
    eval {
        $self->{source}->massage;
        $self->{source}->generate;
    };
    
    my  $err = $@;
    
    close STDOUT;
    open  STDOUT, ">&TMPOUT";
    close TMPOUT;
    
    # test #3
    $self->{builder}->ok($self->{text} = $string, 'generated text');
    
    warn "!!! Error generating text!\n!!!   $err\n"
        if $err;
    
    $self
}

###########################################################################

=item   C<DESTROY($self)>

Destructor for object.

Checks to see if all tests appear to have passed.
If not, dumps generated text to C<STDERR>.

=cut

sub DESTROY
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    warn "<<<<<<<<<<<<<<<\n$self->{text}\n>>>>>>>>>>>>>>>\n"
        if $self->{ok}
        && $self->{failed};
}

###########################################################################

=item   C<import(%self, %flags)>

The import protocol for the package is used to setup conditions
for testing.

=cut

sub import ($%)
{
    my  $class = shift;
    
    $global = $class->new(@_)
        unless isa $global, __PACKAGE__;
    
    die "*** Unable to create @{[ __PACKAGE__ ]}\n"
        unless isa $global, __PACKAGE__;
    
    $global->{builder}->exported_to(scalar(caller));
    $class->export_to_level(1, $class, @EXPORT);
}

###########################################################################
###########################################################################

=item   C<check()>

Checks to see if the underlying Test::Builder has registered a failed test.

Seems clumsy that we have call this after changing the test object.
Sadly, the test object disappears before we get called in C<DESTROY>.
Thus we have to keep this updated the best we can.

=cut

sub check ()
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless isa $self->{builder}, 'Test::Builder';
    
    unless (isa $self->{builder}, 'Test::Builder') {
    } elsif ($self->{builder}->can('is_passing')) {
        $self->{failed} = 1
            unless $self->{builder}->is_passing;
    } elsif (isa $self->{builder}->{Test_Results}, 'ARRAY') {
        for my $t (@{$self->{builder}->{Test_Results}}) {
            $self->{failed} = 1
                unless $t->{ok}
        }
    }
}

###########################################################################

=item   C<comment($self, $match)>

Get generated comment starting with the specified match string.
This allows pulling a specific comment from the generated text.

Comments are assumed to be in C++ multi-line format with a doubled asterisk
on the opening of the comment:

Returns any subsequent matching text from the comment.
The C<$match> is a string, not a regular expression.

=cut

sub comment
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless $self->{ok};
    
    unless (isa $self->{comment}, 'HASH') {
        $self->{comment}->{$1} = $2
            while $self->{text}
                =~ m{/\*\*\s*\n[\*\s]+(.*?)\s*?\n[\*\s]*?(.*?)[\*\s]*\*/}gs;
    }
    
    $self->{comment}->{$_[0]}
}

###########################################################################
###########################################################################

=item   C<contains($text [, $name])>

Checks to see if the the generated text contains the specified text.
If the C<$name> is not provided it is constructed.

=cut

sub contains ($;$)
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless $self->{ok};
    
    my  $text = shift;
    my  $name = shift || qq{contains "$text"};
    
    $self->{builder}->ok(index($self->{text}, $text) >= 0, $name);
    check;
}

###########################################################################

=item   C<like($pattern, $name)>

Marks test based on the generated text matching the specified C<$pattern>.
Much like C<Test::Simple::like()>, with the text target pre-specified.

=cut

sub like ($$)
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless $self->{ok};

    $self->{builder}->like($self->{text}, @_);
    check
}

###########################################################################

=item   C<ok($test, $name)>

Marks test based on boolean test result C<$test>.
Just like C<Test::Simple::ok()>.

=cut

sub ok ($$)
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;

    return
        unless $self->{ok};

    $self->{builder}->ok(@_);
    check
}

###########################################################################
###########################################################################

=item   C<hasComment($tag [, @matches ])>

Checks if generated text contains comment beginning with specified C<$tag>.
This would be something like C<"\file Filter.pm">.

If this is true and subsequent C<@matches> are provided these will be
tested against the body of the comment and the test will pass only if
all of them match.

Note that for purposes of counting tests, this is one test for the
C<$tag> and one test for each of the C<@matches> (may be zero).

=cut

sub hasComment ($;@)
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless $self->{ok};
    
    my  $tag  = shift;
    my  $cmnt = $self->comment($tag);
    my  $name = "/** $tag */";
    my  $ok   = defined $cmnt;
    
    $self->{builder}->ok($ok, $name);
    
    for (@_) {
        my  $fullname = qq{$name "$_"};
        
        if ($ok) {
            $self->{builder}->ok(index($cmnt, $_) >= 0, $fullname);
        } else {
            $self->{builder}->skip($fullname);
        }
    }
    
    check
}

###########################################################################

=item   C<hasMacro()>

Checks if the redefinition-prevention macro is present in the file.
This will look something like:

    #ifndef DoxyFilt
    #define DoxyFilt
    
    ...[snip]...
    
    #endif  DoxyFilt

=cut

sub hasMacro ()
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless $self->{ok};
    
    my  $macro = basename $self->{path};
    
    # this matches Doxygen::Item::File:
    $macro =~ s|^.*:[/\\]||;
    $macro =~ s|\W|_|g;
    
    $self->{builder}->like(
        $self->{text},
        qr((?:^|\n)
           \s*   #ifndef \s+ $macro   \s* \n
           \s*   #define \s+ $macro   \s* \n
           .*?                        \s* \n
           \s*   #endif  \s+ $macro   \s*
           (?:\n|$))sx,
        "$macro re-definition macro");
    check
}

###########################################################################

=item   C<includes($path)>

Checks for a C<#include> for the specified path.

=cut

sub includes ($)
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    my  $path = shift;
    
    return
        unless $self->{ok};
    
    $self->{builder}->like(
        $self->{text},
        qr{\n#include\s+<$path>\s*\n},
        "#include <$path>");
    
    check
}

###########################################################################

=item   C<nameSpace($path)>

Check to see if specified namespace is defined.

=cut

sub nameSpace ($)
{
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;
    
    return
        unless $self->{ok};
    
    my  $pattern = join '', map {
        '\n\s*namespace\s+' . $_ . '\s*\{\s*'
    } split /::/, $_[0];
    
    $self->{builder}->like(
        $self->{text},
        qr($pattern)x,
        "namespace $_[0]");
    check
}

###########################################################################
###########################################################################

=item   C<dumpGeneratedText()>

Bail out of test, incidentally causing generated text to be dumped.

=cut

sub dumpGeneratedText () {
    my  $self = isa($_[0], __PACKAGE__) ? shift : $global;

    $self->{failed} = 1;
}

###########################################################################
###########################################################################

1

__END__

=back

=head1 SEE ALSO

DoxyFilt.pl

=head1 AUTHOR

Marc M. Adkins, L<mailto:Perl@Doorways.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2004-2010 by Marc M. Adkins

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut