Bivio::Test::LanguageWrapper
# Copyright (c) 2009 bivio Software, Inc. All Rights Reserved.
# $Id$
package Bivio::Test::LanguageWrapper;
use strict;
use Bivio::Base 'Bivio::UNIVERSAL';
b_use('IO.Trace');
our($AUTOLOAD);
my($_CL) = b_use('IO.ClassLoader');
my($_L) = b_use('Test.Language');
our($_TRACE);
sub DESTROY {
# You probably don't want to define a DESTROY method. Instead create a
# L<handle_cleanup|"handle_cleanup">.
#
# Subclasses should implement:
#
# sub DESTROY {
# my($self) = @_;
# my destroy code....
# return $self->SUPER::DESTROY;
# }
return;
}
sub AUTOLOAD {
return $_CL->call_autoload($AUTOLOAD, \@_, sub {
my($func, $args) = @_;
my($self) = $_L->assert_in_eval($func);
b_die($self, " function $func: ", _check_autoload($self, $func))
if _check_autoload($self, $func);
_trace($func, ' called with ', $args) if $_TRACE;
my($td) = $self->unsafe_get('test_deviance');
return $self->$func(@$args)
if !$td || $func =~ /^test_(?:conformance|deviance)$/;
my($die) = Bivio::Die->catch_quietly(sub {
return $self->$func(@$args);
});
b_die($self, ' deviance call "', $td, '" failed to die: ', $func, $args)
unless $die;
b_die($self, ' deviance call to ', $func, $args, ' failed with "',
$die, '" but did not match pattern: ', $td)
unless $die->as_string =~ $td;
return;
});
}
sub _check_autoload {
my($self, $func) = @_;
return 'test_setup() must be first function called in test script'
unless $_L->is_blesser_of($self) || $func eq 'test_setup';
return 'language function cannot begin with handle_ or internal_'
if $func =~ /^(?:handle|internal)_/;
return 'test function must be all lower case and begin with letter'
unless $func =~ /^[a-z][a-z0-9_]+$/;
return 'test function must contain an underscore (_)'
unless $func =~ /_/ || Bivio::UNIVERSAL->can($func);
return ref($self) . ' does not implement this function'
unless $self->can($func);
return;
}
1;