File Coverage

testlib/PtsTestLib.pm
Criterion Covered Total %
statement 46 59 77.9
branch 23 36 63.8
condition 4 6 66.6
subroutine 5 7 71.4
pod 0 4 0.0
total 78 112 69.6


line stmt bran cond sub pod time code
1             #! /bin/sh
2             eval '(exit $?0)' && eval 'PERL_BADLANG=x;PATH="$PATH:.";export PERL_BADLANG\
3             PATH;exec perl -x -S -- "$0" ${1+"$@"};#'if 0;eval 'setenv PERL_BADLANG x\
4             ;setenv PATH "$PATH":.;exec perl -x -S -- "$0" $argv:q;#'.q
5             #!perl -w
6             +push@INC,'.';$0=~/(.*)/s;do(index($1,"/")<0?"./$1":$1);die$@if$@__END__+if 0
7             ;#Don't touch/remove lines 1--7: http://www.inf.bme.hu/~pts/Magic.Perl.Header
8             #
9             # pts-test-lib.t -- a simple Perl test framework based on Test::More + aspects of Test::Inline
10             # by pts@fazekas.hu at Mon Dec 26 17:27:27 CET 2005
11             #
12             # This program is free software; you can redistribute it and/or modify
13             # it under the terms of the GNU General Public License as published by
14             # the Free Software Foundation; either version 2 of the License, or
15             # (at your option) any later version.
16             #
17             # This program is distributed in the hope that it will be useful,
18             # but WITHOUT ANY WARRANTY; without even the implied warranty of
19             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20             # GNU General Public License for more details.
21             #
22             # Dat: perl -MTest::Harness "-eruntests@ARGV" test1.t
23             # test1.t:
24             # use Test::More qw(no_plan);
25             # BEGIN { use_ok( 'integer' ); }
26             # is(1, 1.0, "foo");
27             # isnt(1, '1.0', "bar");
28             # Dat: --harness should display: "pts-test....ok\n"
29             # Imp: plan the # tests for Test::
30             # Imp: skip "=begin" inside strings or otherwise quoted
31             #
32              
33             package PtsTestLib;
34 1     1   1505 use integer;
  1         2  
  1         4  
35 1     1   23 use strict;
  1         1  
  1         89  
36             BEGIN {
37 1     1   2 $main::Id='$Id: pts-test.pl,v 1.2 2006/04/26 07:42:33 pts Exp $';
38 1 50       1184 $main::VERSION=$1 if $main::Id=~/,v *([\d.]+)/;
39             }
40             my $SELF='pts-test.pl';
41              
42             #** @param $_[0] output filehandle
43             sub banner($) {
44 0     0 0 0 my $fh=$_[0];
45 0         0 print $fh "This is $SELF, version $main::VERSION, by \n"
46             ."The license is GNU GPL >=2.0. It comes without warranty. USE AT YOUR OWN RISK!\n\n";
47             }
48             #** @param $_[0] output filehandle
49             sub usage($) {
50 0     0 0 0 my $fh=$_[0];
51 0         0 print $fh "Usage: $0 [
52             "Options:\n",
53             "--help this help\n",
54             "--harness run whole test through Test::Harness\n";
55             }
56              
57             my $do_help=0;
58             my $do_harness=0;
59             my $do_work=(defined $ENV{PTS_TEST_DO});
60             @ARGV=split("\n",$ENV{PTS_TEST_DO}) if !@ARGV and $do_work;
61              
62             { my $I;
63             for ($I=0;$I<@ARGV;$I++) {
64             if ($ARGV[$I]eq'--') { $I++; last }
65             elsif (substr($ARGV[$I],0,1)ne'-') { last }
66             elsif ($ARGV[$I]eq'--help') { $do_help++ }
67             elsif ($ARGV[$I]eq'--harness') { $do_harness++ }
68             elsif ($ARGV[$I]eq'--work') { $do_work++ }
69             else { die "$SELF: unknown option: $ARGV[$I]\n" }
70             }
71             splice(@ARGV,0,$I);
72             }
73              
74             if ($do_help) { #
75             banner(\*STDOUT); usage(\*STDOUT); exit 0;
76             }
77              
78             #my $perl_exe=$^X;
79             #$perl_exe='perl' if $^X!~m@perl[^/]*\Z(?!\n)@;
80             #die "$SELF: perl executable not found: $perl_exe\n" if (!-f $perl_exe);
81             ## ^^^ Imp: test `-e' on UNIX
82              
83             if ($do_harness) {
84             $ENV{PTS_TEST_DO}=join("\n",@ARGV); # Imp: quoting
85             require Test::Harness;
86             import Test::Harness;
87             $Test::Harness::switches=""; # Dat: remove "-w", we have /bin/sh in our shebang
88             runtests($0);
89             exit 0;
90             }
91              
92             # Imp: maybe in separate processes?
93             # vvv Dat: `use' here, would add a mandatory dependency on `Test::More', but
94             # it also prints "# No tests run!" with --help.
95             require Test::More;
96             import Test::More qw(no_plan);
97              
98             $|=1;
99             my $errc=0;
100              
101             #** @param $_[0] filename, usually a Perl script or a .pm Perl module
102             sub test_file($) {
103 1     1 0 2 my $testfile=$_[0];
104 1 50       38 if ($testfile=~/[\r\n"\\]/) {
    50          
105 0         0 print STDERR "$SELF: special character in test filename: $testfile\n";
106 0         0 $errc++; next
107 0         0 } elsif (!open F, "< $testfile") {
108 0         0 print STDERR "$SELF: test file missing: $testfile: $!\n";
109 0         0 $errc++; next
110 0         0 }
111 1         435 print "# testing file: $testfile\n"; # Dat: ignored by Test::Harness
112             #** Previous line was whitespace only.
113 1         4 my $prevws_p=1;
114             #** 0: we are outside a testing block
115             #** 1: we are in a `=begin testing' block
116             #** 2: we are in a `=for testing' block
117 1         3 my $in_testing=0;
118 1         3 my $testcode="";
119 1         48 while () {
120 903 100       1947 if (!/\S/) {
121 138 100       206 $testcode.=$_ if $in_testing!=0;
122 138 50       192 $in_testing=0 if $in_testing==2; # Dat: paragraph of `=for' has ended
123 138         102 $prevws_p=1; next
124 138         281 }
125 765         693 $prevws_p=0;
126 765 100 100     3488 if (/^=(begin|for)\s+testing\s*$/) {
    100          
    100          
127 1         9 my $lineno=$.+1;
128 1 50       5 print STDERR "$SELF: nested testing declaration in $testfile:$.\n" if $in_testing!=0;
129 1         7 $testcode.="\n\n#line $lineno \"$testfile\"\n";
130 1 50       12 $in_testing=($1 eq "begin") ? 1 : 2;
131             } elsif ($in_testing==1 and /^=(?:end(?:\s+testing)?|cut)\s*$/) {
132             # Dat: `=end testing' is OK, `=end' isn't, but we're not that picky
133 1         3 $in_testing=0;
134             } elsif ($in_testing!=0) {
135 159         448 $testcode.=$_
136             }
137             }
138 1 50       13 die if !close F;
139 1 50       7 $testfile="./$testfile" if 0>index($testfile,"/"); # Dat: for better do()
140 1 50       3 if (0==length($testcode)) {
141             # Dat: no inline POD tests found
142 0         0 do $testfile;
143             } else {
144 1         900 do $testfile; # Dat: parse definitions etc.
145 1 50       8 die $@ if $@;
146 1         2157 eval $testcode;
147             }
148 1 50       957 die $@ if $@;
149             }
150              
151             # ---
152              
153             #** @param $_[1] Perl package/module name (e.g. MIME::Words)
154             sub test_mod($) {
155 1     1 0 7 my $mod=$_[0];
156 1         2 my $modfn=$mod; $modfn=~s@::@/@g; $modfn.=".pm";
  1         6  
  1         2  
157 1         3 my $dirmodfn;
158 1         3 for my $dir (@INC) {
159 1 50 33     34 if (!ref($dir) and (-f"$dir/$modfn")) { $dirmodfn="$dir/$modfn"; last }
  1         3  
  1         2  
160             }
161 1 50       4 if (defined$dirmodfn) {
162 1         3 test_file($dirmodfn);
163             } else {
164 0           print STDERR "$0: file to test not found: $modfn\n";
165 0           $errc++;
166             }
167             }
168              
169             if ($0 eq __FILE__) {
170             for my $fn (@ARGV) { test_file $fn }
171             exit($errc>99 ? 100 : $errc);
172             }
173              
174             1