File: MyTest.pm

package info (click to toggle)
libgnupg-interface-perl 0.52-10
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,296 kB
  • sloc: perl: 3,637; makefile: 10; sh: 1
file content (63 lines) | stat: -rw-r--r-- 1,090 bytes parent folder | download | duplicates (3)
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
#  MyTest.pm
#    - module for use with test scripts
#
#  Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
#
#  This module is free software; you can redistribute it and/or modify it
#  under the same terms as Perl itself.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
#  $Id: MyTest.pm,v 1.3 2001/08/21 13:31:50 ftobin Exp $
#

package MyTest;

use strict;
use English qw( -no_match_vars );
use Exporter;
use IO::File;
use vars qw( @ISA @EXPORT );

@ISA    = qw( Exporter );
@EXPORT = qw( TEST );

$OUTPUT_AUTOFLUSH = 1;

print "1..", COUNT_TESTS(), "\n";

my $counter = 0;

sub TEST ( & )
{
    my ( $code ) = @_;

    $counter++;

    &$code or print "not ";
    print "ok $counter\n";
}


sub COUNT_TESTS
{
    my ( $file ) = @_;
    $file ||= $PROGRAM_NAME;

    my $tests = 0;

    my $in = IO::File->new( $file );

    while ( $_ = $in->getline() )
    {
        $tests++
          if /^\s*TEST\s*/;
    }

    return $tests;
}


1;