Test.pm
Go to the documentation of this file.
1 #============================================================= -*-Perl-*-
2 #
3 # Pod::POM::Test
4 #
5 # DESCRIPTION
6 # Module implementing some useful subroutines for testing.
7 #
8 # AUTHOR
9 # Andy Wardley <abw@kfs.org>
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 BASIS::Pod::POM::Test;
23 
24 require 5.004;
25 
26 use strict;
27 use BASIS::Pod::POM;
28 use base qw( Exporter );
29 use vars qw( $VERSION @EXPORT );
30 
31 $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
32 @EXPORT = qw( ntests ok match assert );
33 
34 my $ok_count;
35 
36 sub ntests {
37  my $ntests = shift;
38  $ok_count = 1;
39  print "1..$ntests\n";
40 }
41 
42 sub ok {
43  my ($ok, $msg) = @_;
44  if ($ok) {
45  print "ok ", $ok_count++, "\n";
46  }
47  else {
48  print "FAILED $ok_count: $msg\n" if defined $msg;
49  print "not ok ", $ok_count++, "\n";
50  }
51 }
52 
53 sub assert {
54  my ($ok, $err) = @_;
55  return ok(1) if $ok;
56 
57  # failed
58  my ($pkg, $file, $line) = caller();
59  $err ||= "assert failed";
60  $err .= " at $file line $line\n";
61  ok(0);
62  die $err;
63 }
64 
65 
66 sub match {
67  my ($result, $expect) = @_;
68 
69  # force stringification of $result to avoid 'no eq method' overload errors
70  $result = "$result" if ref $result;
71 
72  if ($result eq $expect) {
73  ok(1);
74  }
75  else {
76  print "FAILED $ok_count:\n expect: [$expect]\n result: [$result]\n";
77  ok(0);
78  }
79 }
80 
81 
82 1;