1package Parse::CPAN::Meta::Test;
2
3use strict;
4use Test::More ();
5use Parse::CPAN::Meta;
6use File::Spec;
7
8use vars qw{@ISA @EXPORT};
9BEGIN {
10	require Exporter;
11	@ISA    = qw{ Exporter };
12	@EXPORT = qw{
13		tests  yaml_ok  yaml_error  slurp  load_ok
14		test_data_directory
15	};
16}
17
18sub test_data_directory {
19	return( "corpus" );
20}
21
22# 22 tests per call to yaml_ok
23# 4  tests per call to load_ok
24sub tests {
25	return ( tests => count(@_) );
26}
27
28sub count {
29	my $yaml_ok = shift || 0;
30	my $load_ok = shift || 0;
31	my $single  = shift || 0;
32	my $count   = $yaml_ok * 3 + $load_ok * 4 + $single;
33	return $count;
34}
35
36sub yaml_ok {
37	my $string  = shift;
38	my $array   = shift;
39	my $name    = shift || 'unnamed';
40
41	# Does the string parse to the structure
42	my $yaml_copy = $string;
43	my @yaml      = eval { Parse::CPAN::Meta::Load( $yaml_copy ); };
44	Test::More::is( $@, '', "$name: Parse::CPAN::Meta parses without error" );
45	Test::More::is( $yaml_copy, $string, "$name: Parse::CPAN::Meta does not modify the input string" );
46	SKIP: {
47		Test::More::skip( "Shortcutting after failure", 1 ) if $@;
48		Test::More::is_deeply( \@yaml, $array, "$name: Parse::CPAN::Meta parses correctly" );
49	}
50
51	# Return true as a convenience
52	return 1;
53}
54
55sub yaml_error {
56	my $string = shift;
57	my $yaml   = eval { Parse::CPAN::Meta::Load( $string ); };
58	Test::More::like( $@, qr/$_[0]/, "CPAN::Meta::YAML throws expected error" );
59}
60
61sub slurp {
62	my $file = shift;
63	my $layer = shift;
64	$layer = "" unless defined $layer;
65	local $/ = undef;
66	open my $fh, "<$layer", $file or die "open($file) failed: $!";
67	my $source = <$fh>;
68	close( $fh ) or die "close($file) failed: $!";
69	$source;
70}
71
72sub load_ok {
73	my $name = shift;
74	my $file = shift;
75	my $size = shift;
76	my $layer = shift;
77	Test::More::ok( -f $file, "Found $name" ) or Test::More::diag("Searched at '$file'");
78	Test::More::ok( -r $file, "Can read $name" );
79	my $content = slurp( $file, $layer );
80	Test::More::ok( (defined $content and ! ref $content), "Loaded $name" );
81	Test::More::ok( ($size < length $content), "Content of $name larger than $size bytes" );
82	return $content;
83}
84
851;
86