view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	# parse_prereqs() — documented return structure contracts
	'parse_prereqs.return.hashref'               => q{Returns a HashRef},
	'parse_prereqs.return.absent_phase_missing'  => q{Absent phases not present in hashref},
	'parse_prereqs.return.version_zero'          => q{version is 0 when no minimum declared},
	'parse_prereqs.return.comment_undef'         => q{comment is undef when no inline comment},
	'parse_prereqs.map.prereq_pm'                => q{PREREQ_PM maps to runtime/requires},
	'parse_prereqs.map.build_requires'           => q{BUILD_REQUIRES maps to build/requires},
	'parse_prereqs.map.test_requires'            => q{TEST_REQUIRES maps to test/requires},
	'parse_prereqs.map.configure_requires'       => q{CONFIGURE_REQUIRES maps to configure/requires},
	'parse_prereqs.structured.requires'          => q{Structured prereqs block: requires},
	'parse_prereqs.structured.recommends'        => q{Structured prereqs block: recommends},
	'parse_prereqs.structured.suggests'          => q{Structured prereqs block: suggests},
	'parse_prereqs.meta_merge.prereqs'           => q{META_MERGE nested prereqs extracted},
	'parse_prereqs.inline_comment'               => q{Inline comment captured verbatim},
	'parse_prereqs.silent.unrecognised'          => q{Unrecognised content silently ignored},
);

# Helper: mark a ledger entry as covered, fail loudly if the key was never registered.
sub covered {
	my ($key) = @_;
	fail("Unknown ledger key '$key'") unless exists $LEDGER{$key};
	delete $LEDGER{$key};
}

# -----------------------------------------------------------------------
# Shared fixture factories
# -----------------------------------------------------------------------

# Set up a redirected home directory so _load_develop_config never touches
# the developer's real ~/.config during testing.  Each helper returns a
# mock_scoped guard; callers must hold it (my $g = empty_home()) so the
# mock stays active for the lifetime of the enclosing subtest block.

# A fresh tempdir representing a home dir with NO config file.
sub empty_home {
	my $h = tempdir( CLEANUP => 1 );
	return mock_scoped 'File::HomeDir::my_home' => sub { $h };
}

# Write a YAML config to a fake home dir and return the scoped guard.
sub home_with_config {
	my ($data) = @_;
	my $h = tempdir( CLEANUP => 1 );
	path($h)->child('.config')->mkpath;
	YAML::Tiny->new($data)
		->write( path($h)->child('.config', 'makefilepl2cpanfile.yml')->stringify );
	return mock_scoped 'File::HomeDir::my_home' => sub { $h };
}

# Write a Makefile.PL into a tempdir and return its path object.
sub make_mf {
	my ($content) = @_;
	my $dir = tempdir( CLEANUP => 1 );
	my $mf  = path($dir)->child('Makefile.PL');
	$mf->spew_utf8($content);
	return $mf;
}

Readonly my $MF_SIMPLE =>
	"WriteMakefile(PREREQ_PM => { 'Try::Tiny' => 0 });\n";

Readonly my $MF_VERSIONED =>
	"WriteMakefile(PREREQ_PM => { 'Moo' => '2.000' });\n";

# -----------------------------------------------------------------------
# generate() — error / message paths
# -----------------------------------------------------------------------

subtest 'generate() — croak on unreadable makefile' => sub {
	my $g = empty_home();

	# Missing file: the path does not exist at all.
	my $missing = '/no/such/path/Makefile.PL';
	throws_ok {
		App::makefilepl2cpanfile::generate( makefile => $missing )
	} qr/Cannot read '\Q$missing\E'/, q{exact croak message for missing file};
	covered('generate.croak.cannot_read.missing');

	# Directory: the path exists but is not a file.
	my $dir = tempdir( CLEANUP => 1 );
	throws_ok {
		App::makefilepl2cpanfile::generate( makefile => $dir )
	} qr/Cannot read '\Q$dir\E'/, q{exact croak message when path is a directory};
	covered('generate.croak.cannot_read.directory');

	diag 'generate croak paths verified' if $ENV{TEST_VERBOSE};
};

subtest 'generate() — croak on malformed YAML config' => sub {
	# Config file must exist so _load_develop_config proceeds to YAML::Tiny->read.
	my $g_home = home_with_config( {} );    # creates the file; content irrelevant

	# mock_scoped with multiple pairs restores both methods when $g_yaml goes out
	# of scope at the end of this subtest block.
	my $g_yaml = mock_scoped(
		'YAML::Tiny::read'   => sub { undef },
		'YAML::Tiny::errstr' => sub { 'synthetic YAML failure' },
	);

	my $mf = make_mf($MF_SIMPLE);
	throws_ok {
		App::makefilepl2cpanfile::generate(
			makefile     => "$mf",
			with_develop => 1,
		)
	} qr/Failed to parse .+: synthetic YAML failure/,
		q{croak message includes path and YAML error string};
	covered('generate.croak.failed_to_parse_yaml');

	diag 'generate YAML croak verified' if $ENV{TEST_VERBOSE};
};

subtest 'generate() — carp when config has no develop key' => sub {
	# Config file exists but its 'develop' key is absent.
	my $g = home_with_config( { other_section => { tool => 1 } } );

	my $mf = make_mf($MF_SIMPLE);

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 1,
	);

	ok scalar @warnings > 0, 'a carp warning was issued';
	like $warnings[0], qr/No 'develop' key found in .+; using defaults/,
		q{carp message matches documented text exactly};
	covered('generate.carp.no_develop_key');

	diag 'generate carp verified' if $ENV{TEST_VERBOSE};
};

# -----------------------------------------------------------------------
# generate() — return value contract
# -----------------------------------------------------------------------

subtest 'generate() — return value is Str terminated with a single newline' => sub {
	my $g = empty_home();

	my $mf  = make_mf($MF_SIMPLE);
	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 0,
	);

	ok  defined $out,       'return value is defined';
	ok !ref $out,           'return value is a plain scalar (Str)';
	like $out, qr/\n$/,     'output ends with a newline';
	ok  $out !~ /\n\n$/,    'output does not end with a double newline';
	covered('generate.return.string_single_newline');

	diag 'generate return contract verified' if $ENV{TEST_VERBOSE};
};

# -----------------------------------------------------------------------
# generate() — default argument values
# -----------------------------------------------------------------------

subtest 'generate() — default argument: makefile is "Makefile.PL"' => sub {
	my $g = empty_home();

	# The POD says: default makefile is 'Makefile.PL'.  We test this by
	# chdir-ing to a tempdir that contains a Makefile.PL and calling generate()
	# without a makefile argument.
	my $dir = tempdir( CLEANUP => 1 );
	path($dir)->child('Makefile.PL')->spew_utf8($MF_SIMPLE);

	my $orig = Path::Tiny->cwd;
	chdir $dir;

	my $out;
	lives_ok {
		$out = App::makefilepl2cpanfile::generate( with_develop => 0 )
	} 'generate() reads Makefile.PL from cwd when no makefile arg given';
	like $out, qr/Try::Tiny/, 'content from default Makefile.PL appears in output';

	chdir "$orig";
	covered('generate.arg.default_makefile');
};

subtest 'generate() — default argument: existing is empty string' => sub {
	my $g = empty_home();

	# When 'existing' is omitted, no pre-existing develop entries should be
	# merged (there are none to merge from an empty string).
	my $mf = make_mf($MF_SIMPLE);
	my $out;
	lives_ok {
		$out = App::makefilepl2cpanfile::generate(
			makefile     => "$mf",
			with_develop => 0,
		)
	} 'generate() with no existing arg lives';

	# The output must contain the parsed module but no phantom develop entries
	# from a non-existent pre-existing cpanfile.
	like   $out, qr/Try::Tiny/, 'parsed module present';
	unlike $out, qr/on 'develop' => sub/, 'no develop block from empty existing';
	covered('generate.arg.default_existing_empty');
};

subtest 'generate() — default argument: with_develop is 1 (true)' => sub {
	my $g = empty_home();    # no config file -> uses DEFAULT_DEVELOP

	my $mf  = make_mf($MF_SIMPLE);
	my $out = App::makefilepl2cpanfile::generate( makefile => "$mf" );

	# A develop block must appear because with_develop defaults to 1.
	like $out, qr/on 'develop' => sub/,
		'develop block present when with_develop omitted (default true)';
	covered('generate.arg.default_with_develop_true');
};

# -----------------------------------------------------------------------
# generate() — calling style variants
# -----------------------------------------------------------------------

subtest 'generate() — flat hash calling style' => sub {
	my $g = empty_home();
	my $mf  = make_mf($MF_SIMPLE);
	my $out = App::makefilepl2cpanfile::generate( makefile => "$mf", with_develop => 0 );
	like $out, qr/Try::Tiny/, 'flat hash calling style works';
	covered('generate.calling.flat_hash');
};

subtest 'generate() — hashref calling style' => sub {
	my $g = empty_home();
	my $mf  = make_mf($MF_SIMPLE);
	my $out = App::makefilepl2cpanfile::generate(
		{ makefile => "$mf", with_develop => 0 }
	);
	like $out, qr/Try::Tiny/, 'single hashref calling style works';
	covered('generate.calling.hashref');
};

# -----------------------------------------------------------------------
# generate() — with_develop behaviour
# -----------------------------------------------------------------------

subtest 'generate() — develop block injected when with_develop => 1' => sub {
	# Use an empty home so default tools (Perl::Critic etc.) are injected.
	my $g = empty_home();

	my $mf  = make_mf($MF_SIMPLE);
	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 1,
	);

	like $out, qr/on 'develop' => sub/, 'develop block present';
	# At least one of the four default tools must appear.
	like $out, qr/Perl::Critic|Devel::Cover|Test::Pod/, 'default dev tool present';
	covered('generate.develop.injected_when_true');
};

subtest 'generate() — develop block suppressed when with_develop => 0' => sub {
	my $g = empty_home();
	my $mf  = make_mf($MF_SIMPLE);
	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 0,
	);
	unlike $out, qr/on 'develop' => sub/, 'no develop block when with_develop is false';
	covered('generate.develop.suppressed_when_false');
};

# -----------------------------------------------------------------------
# generate() — existing develop block merging (all three relationship types)
# -----------------------------------------------------------------------

subtest 'generate() — merge existing develop requires' => sub {
	my $g = empty_home();
	my $mf       = make_mf($MF_SIMPLE);
	my $existing = "on 'develop' => sub {\n  requires 'My::Linter';\n};\n";
	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		existing     => $existing,
		with_develop => 0,
	);
	like $out, qr/My::Linter/, 'hand-curated develop requires entry preserved';
	covered('generate.develop.merge_existing_requires');
};

subtest 'generate() — merge existing develop recommends' => sub {
	my $g = empty_home();
	my $mf       = make_mf($MF_SIMPLE);
	my $existing = "on 'develop' => sub {\n  recommends 'My::NiceGUI';\n};\n";
	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		existing     => $existing,
		with_develop => 0,
	);