# $Id: Function.pm 2340 2007-10-28 01:47:34Z comdog $ package Test::Data::Function; use strict; use base qw(Exporter); use vars qw(@EXPORT $VERSION); @EXPORT = qw(prototype_ok); ($VERSION) = q$Revision: 2340 $ =~ m/ (\d+) /xg; use Test::Builder; my $Test = Test::Builder->new(); =head1 NAME Test::Data::Function -- test functions for functions =head1 SYNOPSIS use Test::Data qw(Function); =head1 DESCRIPTION This module provides test functions for subroutine sorts of things. =head2 Functions =over 4 =item prototype_ok( PROTOTYPE, SUB [, NAME ] ) =cut sub prototype_ok(\&$;$) { my $sub = shift; my $prototype = shift; my $name = shift || 'function prototype is correct'; my $actual = prototype( $sub ); my $test = $actual eq $prototype; unless( $test ) { $Test->diag( "Subroutine has prototype [$actual]; expected [$prototype]" ); $Test->ok(0, $name); } else { $Test->ok( $test, $name ); } } =back =head1 SEE ALSO L, L, L, L, L =head1 SOURCE AVAILABILITY This source is part of a SourceForge project which always has the latest sources in CVS, as well as all of the previous releases. http://sourceforge.net/projects/brian-d-foy/ If, for some reason, I disappear from the world, one of the other members of the project can shepherd this module appropriately. =head1 AUTHOR brian d foy, C<< >> =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2007 brian d foy. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut "red leather yellow leather";