view release on metacpan or  search on metacpan

lib/Test/Helper.pm  view on Meta::CPAN

# $Id: Helper.pm 1.7 Fri, 05 Sep 1997 16:08:15 -0400 jesse $

package Test::Helper;
use Carp;
use IO::File;
use vars qw($VERSION @ISA @EXPORT $count $output);
use Exporter;
@ISA=qw(Exporter);
@EXPORT=qw(ok comm test runs heinous syntax_check);
# $Format: "$VERSION='$TestHelperRelease$';"$
$VERSION='0.002';

sub test(&) {
  local($count)=0;
  local($output)='';
  eval {&{+shift}};
  $count++ if $@;		# Simulate something wrong.
  print "1..$count\n$output";
  die $@ if $@;
}

sub ok($;) {
  my $isok=shift;
  $output .= 'not ' unless $isok;
  $count++;
  $output .= "ok $count\n";
}

sub comm(@) {
  my $comm=join '', @_;
  $output .= "# $comm...\n";
}

sub runs(&) {
  my $subr=shift;
  eval {&$subr()};
  not $@;
}

sub heinous(&) {
  carp "`heinous {...}' is deprecated--use `ok not runs {...} instead'";
  my $subr=shift;
  ok not &runs($subr);
}

sub syntax_check() {
  my @mani=grep {
    not /\.(t|PL)$/ and not m!^t/! and $_ ne 'test.pl'
  } map {
    chomp;
    s!^lib/!!;
    $_;
  } IO::File->new('MANIFEST')->getlines;
  print "To be checked: @mani\n";

  local($^W)=1;
  my $file; foreach $file (@mani) {
    if ($file =~ /\.pm$/) {
      comm "Requiring $file";
      eval {require $file};
      print STDERR $@ if $@;
      ok not $@;
    } elsif ($file =~ /\.pl$/ or
	     (-r $file and -x $file and
	      IO::File->new($file)->getline =~ /^\#!\S*perl/)) {
      comm "Syntax-checking $file";
      ok not system $^X, '-wc', $file;
    } else {
      comm "Skipping $file";
    }
  }
}

1;
__END__

=head1 NAME

B<Test::Helper> - easy creation of test scripts

=head1 SYNOPSIS