File: Test.pm

package info (click to toggle)
libclass-makemethods-perl 1.01-5
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid, stretch
  • size: 1,864 kB
  • ctags: 516
  • sloc: perl: 10,495; makefile: 2
file content (73 lines) | stat: -rw-r--r-- 1,761 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
######################################################################
#
#  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 (<IN>) {
    /^\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 = <T>;
  my $c = 0;
  my %tests = map { ++$c, $_ } $content =~ /\nTEST\s+{.*?};/gs;
  @numbers or @numbers = (1 .. $c);
  foreach (@numbers) {
    print "#$_: $tests{$_}\n";
  }
}
  


1;

__END__