view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	my $file = File::Spec->catfile($dir, 'regular.txt');
	open my $fh, '>', $file; close $fh;
	throws_ok {
		App::Project::Doctor::Context->new(root => $file)
	} qr/not a directory/i, 'regular file path croaks';
};

subtest 'Context::verbose accessor' => sub {
	my $dir = tempdir(CLEANUP => 1);
	is(App::Project::Doctor::Context->new(root => $dir, verbose => 0)->verbose, 0, 'verbose 0');
	is(App::Project::Doctor::Context->new(root => $dir, verbose => 1)->verbose, 1, 'verbose 1');
};

subtest 'Context::has_file' => sub {
	my $dir = make_distro('Makefile.PL' => "1;\n");
	my $ctx = _make_ctx($dir);
	ok  $ctx->has_file('Makefile.PL'), 'present file detected';
	ok !$ctx->has_file('nonexistent'), 'absent file returns false';
};

subtest 'Context::has_file -- undef arg croaks' => sub {
	my $dir = tempdir(CLEANUP => 1);
	my $ctx = _make_ctx($dir);
	throws_ok { $ctx->has_file(undef) } qr/requires a relative path/i, 'undef croaks';
};

subtest 'Context::abs_path' => sub {
	my $dir = tempdir(CLEANUP => 1);
	my $ctx = _make_ctx($dir);
	my $abs = $ctx->abs_path('lib/Foo.pm');
	like $abs, qr/lib.Foo\.pm$/, 'path ends with expected suffix';
	ok(File::Spec->file_name_is_absolute($abs), 'result is absolute');
};

subtest 'Context::abs_path -- undef arg croaks' => sub {
	my $dir = tempdir(CLEANUP => 1);
	throws_ok { _make_ctx($dir)->abs_path(undef) }
		qr/requires a relative path/i, 'undef croaks';
};

subtest 'Context::slurp -- reads file content' => sub {
	my $dir = make_distro('README' => "hello world\n");
	my $ctx = _make_ctx($dir);
	my $got = $ctx->slurp('README');
	returns_ok($got, { type => 'scalar' }, 'slurp returns a scalar');
	is $got, "hello world\n", 'content returned verbatim';
};

subtest 'Context::slurp -- undef arg croaks' => sub {
	my $dir = tempdir(CLEANUP => 1);
	throws_ok { _make_ctx($dir)->slurp(undef) }
		qr/requires a relative path/i, 'undef croaks';
};

subtest 'Context::slurp -- missing file croaks' => sub {
	my $dir = tempdir(CLEANUP => 1);
	throws_ok { _make_ctx($dir)->slurp('no-such-file.txt') }
		qr/File not found/i, 'missing file croaks';
};

subtest 'Context::slurp -- $INPUT_RECORD_SEPARATOR is localised' => sub {
	# $/ must be restored after slurp so callers using line-by-line reads
	# are not silently broken by our slurp mode.
	my $dir = make_distro('data.txt' => "a\nb\nc\n");
	my $ctx = _make_ctx($dir);
	my $original_sep = $/;
	$ctx->slurp('data.txt');
	is $/, $original_sep, '$/ restored after slurp';
};

subtest 'Context::perl_files -- extension filter' => sub {
	my $dir = make_distro(
		'lib/Foo.pm'    => '1;',
		'lib/bar.pl'    => '1;',
		'lib/Baz.txt'   => 'ignored',
		'lib/quux.yaml' => 'ignored',
		't/basic.t'     => '1;',
		'lib/Gen.PL'    => '1;',
	);
	my $ctx   = _make_ctx($dir);
	my $files = $ctx->perl_files('lib', 't');
	returns_ok($files, { type => 'arrayref' }, 'perl_files returns an arrayref');
	my %seen  = map { $_ => 1 } @{$files};

	ok  $seen{'lib/Foo.pm'},  '.pm collected';
	ok  $seen{'lib/bar.pl'},  '.pl collected';
	ok  $seen{'lib/Gen.PL'},  '.PL collected';
	ok  $seen{'t/basic.t'},   '.t collected';
	ok !$seen{'lib/Baz.txt'}, '.txt excluded';
	ok !$seen{'lib/quux.yaml'},'yaml excluded';
};

subtest 'Context::perl_files -- defaults to lib/script/bin/t' => sub {
	# When called with no args the four standard directories are searched.
	my $dir = make_distro(
		'lib/A.pm'      => '1;',
		't/foo.t'       => '1;',
		'script/run.pl' => '1;',
	);
	my $ctx   = _make_ctx($dir);
	my $files = $ctx->perl_files;
	my %seen  = map { $_ => 1 } @{$files};
	ok $seen{'lib/A.pm'},      'lib/ included in default';
	ok $seen{'t/foo.t'},       't/ included in default';
	ok $seen{'script/run.pl'}, 'script/ included in default';
};

subtest 'Context::lib_modules -- only .pm under lib/' => sub {
	my $dir = make_distro(
		'lib/A.pm'  => '1;',
		'lib/b.pl'  => '1;',
		't/c.t'     => '1;',
	);
	my $ctx  = _make_ctx($dir);
	my $mods = $ctx->lib_modules;
	my @pm   = grep { /\.pm$/ } @{$mods};
	is scalar @{$mods}, scalar @pm, 'lib_modules returns only .pm files';
};

subtest 'Context::test_files -- only .t under t/' => sub {
	my $dir = make_distro(