File Coverage

lib/XML/Schema/Test.pm

Criterion	Covered	Total	%
statement	34	40	85.0
branch	11	14	78.5
condition	0	2	0.0
subroutine	10	10	100.0
pod	3	5	60.0
total	58	71	81.6

#============================================================= -*-perl-*-
#
# XML::Schema::Test
#
# DESCRIPTION
#   Module for testing XML::Schema modules.
#
# AUTHOR
#   Andy Wardley
#
# COPYRIGHT
#   Copyright (C) 2001 Canon Research Centre Europe Ltd.
#   All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
# REVISION
#   $Id: Test.pm,v 1.1.1.1 2001/08/29 14:30:17 abw Exp $
#
#========================================================================

package XML::Schema::Test;

use strict;
use XML::Schema;
use base qw( Exporter );
use vars qw( $VERSION $DEBUG $ERROR @EXPORT );

$VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG   = 0 unless defined $DEBUG;
$ERROR   = '';

@EXPORT  = qw( ntests ok match assert );

my $ok_count;
my @results;

sub ntests {
    my $ntests = shift;
    # add the number of any cached results to $ntests
    $ntests += scalar @results;
    $ok_count  = 1;
    print "1..$ntests\n";
    # flush cached results
    foreach (@results) { ok(@$_) };
}

sub ok {
    my ($ok, $msg) = @_;

    # cache results if ntests() not yet called
    unless ($ok_count) {
	push(@results, [ $ok, $msg ]);
	return $ok;
    }

    if ($ok) {
	print "ok ", $ok_count++, "\n";
    }
    else {
	print "FAILED $ok_count: $msg\n" if defined $msg;
	print "not ok ", $ok_count++, "\n";
    }
}

sub assert {
    my ($ok, $err) = @_;
    return ok(1) if $ok;

    # failed
    my ($pkg, $file, $line) = caller();
    $err ||= "assert failed";
    $err .= " at $file line $line\n";
    ok(0);
    die $err;
}


sub match {
    my ($result, $expect) = @_;

    # force stringification of $result to avoid 'no eq method' overload errors
    $result = "$result" if ref $result;

    if ($result eq $expect) {
	ok(1);
    }
    else {
	ok(0, "match failed:\n  expect: [$expect]\n  result: [$result]\n");
    }
}

sub flush {
    ntests(0) unless $ok_count;
}

sub END {
    flush();	    # ensure any cached results get flushed
}


1;

__END__