# Copyright (c) 2009 bivio Software, Inc.  All Rights Reserved.
#
# Visit http://www.bivio.biz for more info.
# 
# This library is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library;  If not, you may get a copy from:
# http://www.opensource.org/licenses/lgpl-license.html
# 
# $Id: LanguageWrapper.pm,v 1.1 2009/12/10 00:17:53 nagler Exp $
package Bivio::Test::LanguageWrapper;
use strict;
use Bivio::Base 'Bivio::UNIVERSAL';
b_use('IO.Trace');

our($VERSION) = sprintf('%d.%02d', q$Revision: 1.1 $ =~ /\d+/g);
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_blessed($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;