line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#============================================================= -*-Perl-*- |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Pod::POM::Test |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# DESCRIPTION |
6
|
|
|
|
|
|
|
# Module implementing some useful subroutines for testing. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# AUTHOR |
9
|
|
|
|
|
|
|
# Andy Wardley |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# COPYRIGHT |
12
|
|
|
|
|
|
|
# Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. |
13
|
|
|
|
|
|
|
# |
14
|
|
|
|
|
|
|
# This module is free software; you can redistribute it and/or |
15
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
16
|
|
|
|
|
|
|
# |
17
|
|
|
|
|
|
|
# REVISION |
18
|
|
|
|
|
|
|
# $Id: Test.pm 14 2009-03-13 08:19:40Z ford $ |
19
|
|
|
|
|
|
|
# |
20
|
|
|
|
|
|
|
#======================================================================== |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
package Pod::POM::Test; |
23
|
|
|
|
|
|
|
$Pod::POM::Test::VERSION = '2.00'; |
24
|
|
|
|
|
|
|
require 5.006; |
25
|
|
|
|
|
|
|
|
26
|
13
|
|
|
13
|
|
15474
|
use strict; |
|
13
|
|
|
|
|
24
|
|
|
13
|
|
|
|
|
330
|
|
27
|
13
|
|
|
13
|
|
59
|
use warnings; |
|
13
|
|
|
|
|
23
|
|
|
13
|
|
|
|
|
360
|
|
28
|
|
|
|
|
|
|
|
29
|
13
|
|
|
13
|
|
3720
|
use Pod::POM; |
|
13
|
|
|
|
|
24
|
|
|
13
|
|
|
|
|
557
|
|
30
|
13
|
|
|
13
|
|
60
|
use parent qw( Exporter ); |
|
13
|
|
|
|
|
20
|
|
|
13
|
|
|
|
|
65
|
|
31
|
13
|
|
|
13
|
|
574
|
use vars qw( @EXPORT ); |
|
13
|
|
|
|
|
23
|
|
|
13
|
|
|
|
|
4325
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
@EXPORT = qw( ntests ok match assert ); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $ok_count; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub ntests { |
38
|
13
|
|
|
13
|
0
|
150
|
my $ntests = shift; |
39
|
13
|
|
|
|
|
31
|
$ok_count = 1; |
40
|
13
|
|
|
|
|
167
|
print "1..$ntests\n"; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub ok { |
44
|
88
|
|
|
88
|
0
|
125
|
my ($ok, $msg) = @_; |
45
|
88
|
50
|
|
|
|
178
|
if ($ok) { |
46
|
88
|
|
|
|
|
289
|
print "ok ", $ok_count++, "\n"; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
else { |
49
|
0
|
0
|
|
|
|
0
|
print "FAILED $ok_count: $msg\n" if defined $msg; |
50
|
0
|
|
|
|
|
0
|
print "not ok ", $ok_count++, "\n"; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub assert { |
55
|
23
|
|
|
23
|
0
|
195
|
my ($ok, $err) = @_; |
56
|
23
|
50
|
|
|
|
70
|
return ok(1) if $ok; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# failed |
59
|
0
|
|
|
|
|
0
|
my ($pkg, $file, $line) = caller(); |
60
|
0
|
|
0
|
|
|
0
|
$err ||= "assert failed"; |
61
|
0
|
|
|
|
|
0
|
$err .= " at $file line $line\n"; |
62
|
0
|
|
|
|
|
0
|
ok(0); |
63
|
0
|
|
|
|
|
0
|
die $err; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub match { |
68
|
61
|
|
|
61
|
0
|
571
|
my ($result, $expect) = @_; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# force stringification of $result to avoid 'no eq method' overload errors |
71
|
61
|
100
|
|
|
|
150
|
$result = "$result" if ref $result; |
72
|
|
|
|
|
|
|
|
73
|
61
|
50
|
|
|
|
150
|
if ($result eq $expect) { |
74
|
61
|
|
|
|
|
113
|
ok(1); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
else { |
77
|
0
|
|
|
|
|
|
print "FAILED $ok_count:\n expect: [$expect]\n result: [$result]\n"; |
78
|
0
|
|
|
|
|
|
ok(0); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
1; |