#!/usr/bin/perl
# Unit tests for the PITA::XML::Platform class
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use Test::More tests => 15;
use Config ();
use PITA::XML ();
# Extra testing functions
sub dies {
my $code = shift;
eval { &$code() };
ok( $@, $_[0] || 'Code dies as expected' );
}
sub dies_like {
my $code = shift;
my $regexp = shift;
eval { &$code() };
like( $@, $regexp, $_[0] || 'Core dies like expected' );
}
#####################################################################
# Testing a sample of the functionality
# Creating with bad params dies
dies( sub { PITA::XML::Platform->new },
'->new(no params) dies' );
dies( sub { PITA::XML::Platform->new(
path => 'foo',
) },
'->new(bin) dies as expected' );
# Again, but using a legal x_foo scheme
isa_ok( PITA::XML::Platform->new(
scheme => 'x_foo',
path => 'foo',
env => { foo => 'bar' },
config => { foo => 'bar' },
), 'PITA::XML::Platform' );
# The easiest test to do is to get the current platform
my $perl5 = PITA::XML::Platform->autodetect_perl5;
isa_ok( $perl5, 'PITA::XML::Platform' );
is( $perl5->scheme, 'perl5', '->scheme matches expected' );
is( $perl5->path, $^X, '->bin matches expected' );
is_deeply( $perl5->env, \%ENV, '->env matches expected' );
is_deeply( $perl5->config, \%Config::Config, '->config matches expected' );
#####################################################################
# Check for specific errors
# A missing scheme
dies_like( sub { PITA::XML::Platform->new(
scheme => '', # A close to legal as possible without being so
path => 'foo',
env => { foo => 'bar' },
config => { foo => 'bar' },
) },
qr/Invalid or missing platform testing scheme/,
'->new(missing scheme) dies like expected' );
# A bad scheme
dies_like( sub { PITA::XML::Platform->new(
scheme => 'foo', # Not in the core scheme set
path => 'foo',
env => { foo => 'bar' },
config => { foo => 'bar' },
) },
qr/Invalid or missing platform testing scheme/,
'->new(bad scheme) dies like expected' );
# A missing path
dies_like( sub { PITA::XML::Platform->new(
scheme => 'perl5',
path => '',
env => { foo => 'bar' },
config => { foo => 'bar' },
) },
qr/Invalid or missing scheme path/,
'->new(missing path) dies like expected' );
# A missing env
dies_like( sub { PITA::XML::Platform->new(
scheme => 'perl5',
path => 'foo',
env => '',
config => { foo => 'bar' },
) },
qr/Invalid, missing, or empty environment/,
'->new(missing env) dies like expected' );
# An empty env
dies_like( sub { PITA::XML::Platform->new(
scheme => 'perl5',
path => 'foo',
env => { },
config => { foo => 'bar' },
) },
qr/Invalid, missing, or empty environment/,
'->new(empty env) dies like expected' );
# A missing config
dies_like( sub { PITA::XML::Platform->new(
scheme => 'perl5',
path => 'foo',
env => { foo => 'bar' },
config => '',
) },
qr/Invalid, missing, or empty config/,
'->new(missing config) dies like expected' );
# An empty config
dies_like( sub { PITA::XML::Platform->new(
scheme => 'perl5',
path => 'foo',
env => { foo => 'bar' },
config => { },
) },
qr/Invalid, missing, or empty config/,
'->new(empty config) dies like expected' );
exit(0);