File Coverage

lib/Pod/POM/Test.pm
Criterion Covered Total %
statement 27 36 75.0
branch 5 10 50.0
condition 0 2 0.0
subroutine 9 9 100.0
pod 0 4 0.0
total 41 61 67.2


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;