File Coverage

tests/xemulator/class_methodmaker/Test.pm

Criterion	Covered	Total	%
statement	21	31	67.7
branch	4	10	40.0
condition	1	3	33.3
subroutine	5	6	83.3
pod	0	3	0.0
total	31	53	58.4

######################################################################
#
#  Please Note: This test module is deprecated, but included for
#  compatibility with some of the older tests in this distribution.
#
######################################################################

package Test;

#
# $Id: Test.pm,v 1.1 2000/04/26 04:29:41 recoil Exp $
#

# COPYRIGHT NOTICE
#
# Copyright 1996 Organic Online, Inc.  Title, ownership rights, and
# intellectual property rights in and to this software remain with
# Organic Online, Inc.  Organic Online, Inc. hereby reserves all rights
# in and to this software.  This software may not be copied, modified,
# or used without a license from Organic Online, Inc.  This software is
# protected by international copyright laws and treaties, and may be
# protected by other law.  Violation of copyright laws may result in
# civil liability and criminal penalties.

use strict;

use Exporter;
use vars qw ( @ISA @EXPORT );
@ISA = qw ( Exporter );
@EXPORT = qw ( TEST COUNT_TESTS PRINT_TEST_HEADER find_test );

my $COUNTER = 0;

$| = 1;
print "1..", &COUNT_TESTS(), "\n" unless $0 =~ /^-e/;

sub TEST (&) {
  my ($code) = @_;
  $COUNTER++;
  &$code or print "not ";
  print "ok $COUNTER\n";
}

sub COUNT_TESTS {
  my ($file) = @_;
  $file ||= $0;
  my $c = 0;
  open(IN, $file) or die "Can't open $file: $!";
  while () {
    /^\s*#/ and next;
    $c += s/(TEST\s{)/$1/g;
  }
  $c;
}

sub find_test ($@) {
  my ($file, @numbers) = @_;
  open(T, $file) or die "Can't open $file: $!";
  local $/ = undef;
  my $content = ;
  my $c = 0;
  my %tests = map { ++$c, $_ } $content =~ /\nTEST\s+{.*?};/gs;
  @numbers or @numbers = (1 .. $c);
  foreach (@numbers) {
    print "#$_: $tests{$_}\n";
  }
}



1;

__END__