BASIS  r3148
Test.pm
Go to the documentation of this file.
00001 #============================================================= -*-Perl-*-
00002 #
00003 # Pod::POM::Test
00004 #
00005 # DESCRIPTION
00006 #   Module implementing some useful subroutines for testing.
00007 #
00008 # AUTHOR
00009 #   Andy Wardley   <abw@kfs.org>
00010 #
00011 # COPYRIGHT
00012 #   Copyright (C) 2000, 2001 Andy Wardley.  All Rights Reserved.
00013 #
00014 #   This module is free software; you can redistribute it and/or
00015 #   modify it under the same terms as Perl itself.
00016 #
00017 # REVISION
00018 #   $Id: Test.pm 14 2009-03-13 08:19:40Z ford $
00019 #
00020 #========================================================================
00021 
00022 package BASIS::Pod::POM::Test;
00023 
00024 require 5.004;
00025 
00026 use strict;
00027 use BASIS::Pod::POM;
00028 use base qw( Exporter );
00029 use vars qw( $VERSION @EXPORT );
00030 
00031 $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
00032 @EXPORT  = qw( ntests ok match assert );
00033 
00034 my $ok_count;
00035 
00036 sub ntests {
00037     my $ntests = shift;
00038     $ok_count  = 1;
00039     print "1..$ntests\n";
00040 }
00041 
00042 sub ok {
00043     my ($ok, $msg) = @_;
00044     if ($ok) {
00045     print "ok ", $ok_count++, "\n";
00046     }
00047     else {
00048     print "FAILED $ok_count: $msg\n" if defined $msg;
00049     print "not ok ", $ok_count++, "\n";
00050     }
00051 }
00052 
00053 sub assert {
00054     my ($ok, $err) = @_;
00055     return ok(1) if $ok;
00056 
00057     # failed
00058     my ($pkg, $file, $line) = caller();
00059     $err ||= "assert failed";
00060     $err .= " at $file line $line\n";
00061     ok(0);
00062     die $err;
00063 }
00064 
00065 
00066 sub match {
00067     my ($result, $expect) = @_;
00068 
00069     # force stringification of $result to avoid 'no eq method' overload errors
00070     $result = "$result" if ref $result;    
00071 
00072     if ($result eq $expect) {
00073     ok(1);
00074     }
00075     else {
00076     print "FAILED $ok_count:\n  expect: [$expect]\n  result: [$result]\n";
00077     ok(0);
00078     }
00079 }
00080 
00081 
00082 1;