view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	throws_ok { _make_ctx($dir)->find_files(undef) }
		qr/requires a directory/i, 'undef dir croaks';
};

subtest 'Context::_collect_files -- skips missing directories' => sub {
	# A dir name that does not exist on disk must be silently skipped, not
	# throw an error -- the user may not have all optional dirs present.
	my $dir = tempdir(CLEANUP => 1);
	my $ctx = _make_ctx($dir);
	lives_ok {
		$ctx->_collect_files(['nonexistent_dir'], sub { 1 });
	} 'non-existent dir in list is silently skipped';
	my $result = $ctx->_collect_files(['nonexistent_dir'], sub { 1 });
	is scalar @{$result}, 0, 'returns empty arrayref for missing dir';
};

subtest 'Context -- memory cycle check' => sub {
	my $dir = tempdir(CLEANUP => 1);
	memory_cycle_ok(_make_ctx($dir), 'Context has no circular references');
};

diag 'Context: done' if $ENV{TEST_VERBOSE};

# ===========================================================================
# 3. App::Project::Doctor::Check::Base
# ===========================================================================

require_ok 'App::Project::Doctor::Check::Base';

subtest 'Check::Base::new -- creates blessed object' => sub {
	my $b = App::Project::Doctor::Check::Base->new;
	isa_ok $b, 'App::Project::Doctor::Check::Base';
};

subtest 'Check::Base -- required methods croak with class name' => sub {
	my $b = App::Project::Doctor::Check::Base->new;

	# The error message must name the class so developers know which
	# subclass is missing the implementation.
	throws_ok { $b->name }
		qr/App::Project::Doctor::Check::Base must implement name/,
		'name() croaks with class name';

	throws_ok { $b->description }
		qr/App::Project::Doctor::Check::Base must implement description/,
		'description() croaks with class name';

	throws_ok { $b->check('ctx') }
		qr/App::Project::Doctor::Check::Base must implement check/,
		'check() croaks with class name';
};

subtest 'Check::Base -- optional method defaults' => sub {
	my $b = App::Project::Doctor::Check::Base->new;
	is $b->can_fix,  0,         'can_fix defaults to 0 (not just false)';
	is $b->category, 'general', 'category defaults to "general"';
	is $b->order,    50,        'order defaults to 50';
};

subtest 'Check::Base -- subclass inherits and overrides' => sub {
	# Create an inline subclass to verify inheritance mechanics.
	{
		package My::ConcreteCheck;
		use parent -norequire, 'App::Project::Doctor::Check::Base';
		sub name        { 'Concrete' }
		sub description { 'A test check.' }
		sub check       { () }
		sub can_fix     { 1 }
		sub order       { 99 }
	}

	my $c = My::ConcreteCheck->new;
	is $c->name,        'Concrete',       'overridden name';
	is $c->description, 'A test check.',  'overridden description';
	is $c->can_fix,     1,                'overridden can_fix';
	is $c->order,       99,               'overridden order';
	is $c->category,    'general',        'inherited category default';
};

subtest 'Check::Base -- subclass name appears in croak message' => sub {
	# If a subclass forgets to implement a method the error must point to
	# the subclass, not Base, so the developer knows where to look.
	{
		package My::IncompleteCheck;
		use parent -norequire, 'App::Project::Doctor::Check::Base';
		sub name        { 'Incomplete' }
		sub description { 'Missing check().' }
		# check() not implemented
	}
	my $ic = My::IncompleteCheck->new;
	throws_ok { $ic->check }
		qr/My::IncompleteCheck must implement check/,
		'subclass name appears in error';
};

diag 'Check::Base: done' if $ENV{TEST_VERBOSE};

# ===========================================================================
# 4. App::Project::Doctor::Report
# ===========================================================================

require_ok 'App::Project::Doctor::Report';

subtest 'Report::new -- starts empty and clean' => sub {
	my $r = App::Project::Doctor::Report->new;
	isa_ok $r, 'App::Project::Doctor::Report';
	is scalar($r->all_findings), 0, 'no findings on construction';
	is $r->exit_code,            0, 'exit_code 0 when clean';
	ok !$r->has_errors,             'has_errors false initially';
	ok !$r->has_warnings,           'has_warnings false initially';
};

subtest 'Report::add_findings -- appends and returns $self' => sub {
	my $r   = App::Project::Doctor::Report->new;
	my $f   = _make_finding(severity => $ERR_SEV, message => 'bad', check_name => 'X');
	my $ret = $r->add_findings($f);
	is $ret, $r, 'returns $self for chaining';
	is scalar($r->all_findings), 1, 'finding appended';
};

subtest 'Report::add_findings -- rejects non-Finding objects' => sub {

t/function.t  view on Meta::CPAN

	my $dir = make_distro(
		'LICENSE'   => "GNU GENERAL PUBLIC LICENSE\nVersion 2\n",
		'META.json' => '{}',
	);
	my @f = App::Project::Doctor::Check::License->new->check(_make_ctx($dir));
	my $lic_match_pass = grep { $_->severity eq $PASS_SEV } @f;
	ok $lic_match_pass, 'pass when LICENSE content matches declared META license';
};

subtest 'Check::License::_meta_license_id -- returns undef on parse failure' => sub {
	mock_exception 'CPAN::Meta::load_file' => 'parse error';
	is App::Project::Doctor::Check::License::_meta_license_id('/fake/META.yml'),
		undef, 'returns undef when CPAN::Meta cannot parse the file';
	restore_all 'CPAN::Meta';
};

diag 'Check::License: done' if $ENV{TEST_VERBOSE};

# ===========================================================================
# 11. Check::Meta
# ===========================================================================

require_ok 'App::Project::Doctor::Check::Meta';

subtest 'Check::Meta -- metadata' => sub {
	my $c = App::Project::Doctor::Check::Meta->new;
	is $c->name,    'META', 'name';
	is $c->can_fix, 0,      'can_fix false';
	is $c->order,   30,     'order';
};

subtest 'Check::Meta::check -- warning only when no META but builder exists' => sub {
	my $dir = make_distro('Makefile.PL' => '');
	my @f   = App::Project::Doctor::Check::Meta->new->check(_make_ctx($dir));
	my $meta_warn    = grep { $_->severity eq $WARN_SEV } @f;
	my $meta_err     = grep { $_->severity eq $ERR_SEV  } @f;
	ok  $meta_warn,  'warning when no META file';
	ok !$meta_err,   'no error when builder present';
};

subtest 'Check::Meta::check -- warning + error when no META and no builder' => sub {
	my $dir = tempdir(CLEANUP => 1);
	my @f   = App::Project::Doctor::Check::Meta->new->check(_make_ctx($dir));
	my $no_meta_warn = grep { $_->severity eq $WARN_SEV } @f;
	my $no_meta_err  = grep { $_->severity eq $ERR_SEV  } @f;
	ok $no_meta_warn, 'warning emitted';
	ok $no_meta_err,  'error emitted for missing builder';
};

subtest 'Check::Meta::check -- error when META parse fails' => sub {
	mock_exception 'CPAN::Meta::load_file' => 'bad yaml';
	my $dir = make_distro('META.yml' => 'invalid: [yaml');
	my @f   = App::Project::Doctor::Check::Meta->new->check(_make_ctx($dir));
	my $parse_err = grep { $_->severity eq $ERR_SEV && $_->message =~ /Failed to parse/i } @f;
	ok $parse_err, 'error emitted on parse failure';
	restore_all 'CPAN::Meta';
};

subtest 'Check::Meta::check -- error per missing required field' => sub {
	# license is intentionally absent to verify that field is required.
	my $struct = {
		name     => 'MyDist',
		version  => '0.01',
		author   => ['Test Author'],
		abstract => 'Something',
	};
	my $g = mock_scoped('CPAN::Meta',
		load_file => sub { return bless {}, 'CPAN::Meta' },
		as_struct  => sub { return $struct },
	);
	my $dir = make_distro('META.yml' => '');
	my @f   = App::Project::Doctor::Check::Meta->new->check(_make_ctx($dir));
	my $lic_field = grep { $_->message =~ /'license'/ } @f;
	ok $lic_field, 'error for missing license field';
};

subtest 'Check::Meta::check -- pass when all required fields present' => sub {
	my $struct = {
		name     => 'MyDist',
		version  => '0.01',
		author   => ['Author'],
		abstract => 'Desc',
		license  => 'gpl_2',
	};
	my $g = mock_scoped('CPAN::Meta',
		load_file => sub { return bless {}, 'CPAN::Meta' },
		as_struct  => sub { return $struct },
	);
	my $dir = make_distro('META.yml' => '');
	my @f   = App::Project::Doctor::Check::Meta->new->check(_make_ctx($dir));
	my $all_fields_pass = grep { $_->severity eq $PASS_SEV } @f;
	ok $all_fields_pass, 'pass when all fields present';
};

diag 'Check::Meta: done' if $ENV{TEST_VERBOSE};

# ===========================================================================
# 12. Check::Pod
# ===========================================================================

require_ok 'App::Project::Doctor::Check::Pod';

subtest 'Check::Pod -- metadata' => sub {
	my $c = App::Project::Doctor::Check::Pod->new;
	is $c->name,    'POD', 'name';
	is $c->can_fix, 1,     'can_fix true';
	is $c->order,   40,    'order';
};

subtest 'Check::Pod::check -- info when lib/ is empty' => sub {
	my $dir = make_distro('Makefile.PL' => '');
	my @f   = App::Project::Doctor::Check::Pod->new->check(_make_ctx($dir));
	my $no_pm_info = grep { $_->severity eq $INFO_SEV } @f;
	ok $no_pm_info, 'info when no .pm files';
};

subtest 'Check::Pod::check -- pass when module has valid POD' => sub {
	my $dir = make_distro(
		'lib/Good.pm' => "package Good;\n=head1 NAME\nGood - testing\n=cut\n1;\n",
	);