# -*- Mode: Perl -*-
#
# test3.t - Redland perl test 3 - error and warnings
#
# $Id: test3.t 10593 2006-03-05 08:30:38Z dajobe $
#
# Copyright (C) 2000-2005 David Beckett - http://purl.org/net/dajobe/
# Copyright (C) 2000-2005 University of Bristol - http://www.bristol.ac.uk/
#
# This package is Free Software or Open Source available under the
# following licenses (these are alternatives):
# 1. GNU Lesser General Public License (LGPL)
# 2. GNU General Public License (GPL)
# 3. Mozilla Public License (MPL)
#
# See LICENSE.html or LICENSE.txt at the top of this package for the
# full license terms.
#
#
#
######################### We start with some black magic to print on failure.
BEGIN { $| = 1; print "1..3\n"; }
END {print "not ok 1\n" unless $loaded;}
use RDF::Redland::CORE;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
use strict;
my $test=2;
# Test using Redland module only
my $debug=defined $ENV{'TEST_VERBOSE'};
my $world=&RDF::Redland::CORE::librdf_new_world();
&RDF::Redland::CORE::librdf_world_open($world);
&RDF::Redland::CORE::librdf_perl_world_init($world);
package RDF::Redland::World;
sub message ($$) {
my($code, $level, $facility, $message, $line, $column, $byte, $file, $uri)=@_;
if($level > 3) {
if(ref $RDF::Redland::Error_Sub) {
return $RDF::Redland::Error_Sub->($message);
} else {
die "Redland error: $message\n";
}
} else {
if(ref $RDF::Redland::Warning_Sub) {
return $RDF::Redland::Warning_Sub->($message);
} else {
warn "Redland warning: $message\n";
}
}
1;
}
package main;
# check 'die' works
my $result='not ok';
eval '&RDF::Redland::CORE::librdf_internal_test_error($world)';
$result='ok' if $@ =~ /test error message number 1/;
print "$result $test\n";
$test++;
# check 'warn' works
$::warn_worked='not ok';
$SIG{__WARN__}=sub { $::warn_worked='ok' if shift =~ /test warning message number 2/ };
&RDF::Redland::CORE::librdf_internal_test_warning($world);
print "$::warn_worked $test\n";
&RDF::Redland::CORE::librdf_perl_world_finish();
$world=undef;
exit 0;