The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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);