view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

	my $m   = App::Test::Generator::Mutation::NumericBoundary->new();
	my $doc = PPI::Document->new(\"sub foo { my \$line = <\$fh>; }\n");
	my @mutants;
	lives_ok(sub { @mutants = $m->mutate($doc) }, 'readline: lives');
	is(scalar @mutants, 0, 'readline < not treated as comparison');
};

# ==================================================================
# LCSAJ — pathological inputs
# ==================================================================

subtest 'LCSAJ: module with single-line subs' => sub {
	my $tmpdir = tempdir(CLEANUP => 1);
	require Cwd;
	my $orig = Cwd::cwd();
	chdir $tmpdir or die $!;

	open my $fh, '>', 'Inline.pm' or die $!;
	print $fh "package Inline;\n";
	print $fh "sub foo { return 1 }\n" x 20;
	print $fh "1;\n";
	close $fh;

	my $paths;
	lives_ok(sub { $paths = App::Test::Generator::LCSAJ->generate('Inline.pm', 'out') },
		'single-line subs: lives');
	chdir $orig;
	is(ref($paths), 'ARRAY', 'returns arrayref');
};

subtest 'LCSAJ: module with empty subs' => sub {
	my $tmpdir = tempdir(CLEANUP => 1);
	require Cwd;
	my $orig = Cwd::cwd();
	chdir $tmpdir or die $!;

	open my $fh, '>', 'Empty.pm' or die $!;
	print $fh "package Empty;\n";
	print $fh "sub foo { }\nsub bar { }\nsub baz { }\n";
	print $fh "1;\n";
	close $fh;

	my $paths;
	lives_ok(sub { $paths = App::Test::Generator::LCSAJ->generate('Empty.pm', 'out') },
		'empty subs: lives');
	chdir $orig;
	is(scalar @{$paths}, 0, 'empty subs: no paths');
};

subtest 'LCSAJ: output directory not writable gracefully croaks' => sub {
	my $tmpdir = tempdir(CLEANUP => 1);
	my $pm     = File::Spec->catfile($tmpdir, 'Foo.pm');
	open my $fh, '>', $pm or die $!;
	print $fh "package Foo;\nsub bar { return 1; }\n1;\n";
	close $fh;

	SKIP: {
		skip 'running as root', 1 if $> == 0;
		my $no_write = File::Spec->catdir($tmpdir, 'no_write');
		mkdir $no_write or die $!;
		chmod 0444, $no_write;
		throws_ok(
			sub { App::Test::Generator::LCSAJ->generate($pm, $no_write) },
			qr/Cannot|write|permission/i,
			'unwritable output dir croaks',
		);
		chmod 0755, $no_write;
	}
};

# ==================================================================
# Planner — boundary and pathological inputs
# ==================================================================

subtest 'Planner: empty schemas produces empty plan' => sub {
	my $p = App::Test::Generator::Planner->new(
		schemas => {},
		package => 'Foo',
	);
	my $plan = $p->plan_all();
	is_deeply($plan, {}, 'empty schemas -> empty plan');
};

subtest 'Planner: schema with undef output type' => sub {
	my $p = App::Test::Generator::Planner->new(
		schemas => { foo => { output => { type => undef } } },
		package => 'Foo',
	);
	lives_ok(sub { $p->plan_all() }, 'undef output type does not crash');
};

subtest 'Planner: schema with 100 methods' => sub {
	my %schemas;
	for my $i (1..100) { $schemas{"method_$i"} = { output => {} } }
	my $p = App::Test::Generator::Planner->new(
		schemas => \%schemas,
		package => 'Foo',
	);
	my $plan;
	lives_ok(sub { $plan = $p->plan_all() }, '100-method plan does not crash');
	is(scalar keys %{$plan}, 100, '100 methods planned');
};

subtest 'Planner: all accessor types in one schema' => sub {
	my %schemas = (
		getter   => { accessor => { type => 'get' },      output => {} },
		setter   => { accessor => { type => 'getset' },   output => {} },
		injector => { accessor => { type => 'injector' }, output => {} },
		boolean  => { output   => { type => 'boolean' } },
		plain    => { output   => {} },
	);
	my $p = App::Test::Generator::Planner->new(
		schemas => \%schemas,
		package => 'Foo',
	);
	my $plan;
	lives_ok(sub { $plan = $p->plan_all() }, 'mixed accessor types do not crash');
	ok($plan->{getter}{getter_test},        'getter -> getter_test');
	ok($plan->{setter}{getset_test},        'setter -> getset_test');
	ok($plan->{injector}{object_injection_test}, 'injector -> object_injection_test');
	ok($plan->{boolean}{boolean_test},      'boolean output -> boolean_test');
	ok(!$plan->{plain}{boolean_test},       'plain output -> no boolean_test');
};

# ==================================================================
# Emitter::Perl — boundary and pathological inputs
# ==================================================================