view release on metacpan or  search on metacpan

t/path.t  view on Meta::CPAN

subtest 'PS-4: D=TRUE(undef last) list context => carp + empty list' => sub {
	my $obj = Genealogy::Wills->new(directory => $temp_dir);
	my @results;
	warning_like(
		sub { @results = $obj->search(last => undef) },
		qr/Value for 'last' is mandatory/,
		'PS-4: carp text matches documented message'
	);
	is(scalar @results, 0, 'PS-4: bare return in list context => empty list');
};

# -----------------------------------------------------------------------
# PS-4b  D=TRUE(last=undef)  scalar context -> carp + undef
# Bare `return;` yields undef (not empty list) in scalar context.
# -----------------------------------------------------------------------
subtest 'PS-4b: D=TRUE(undef last) scalar context => carp + undef' => sub {
	my $obj    = Genealogy::Wills->new(directory => $temp_dir);
	my $result = 'sentinel';
	warning_like(
		sub { $result = $obj->search(last => undef) },
		qr/Value for 'last' is mandatory/,
		'PS-4b: carp fires in scalar context too'
	);
	ok(!defined $result, 'PS-4b: bare return in scalar context => undef, not empty list');
};

# -----------------------------------------------------------------------
# PS-5  E: wills->new() returns undef  F=TRUE -> croak "Can't open..."
# -----------------------------------------------------------------------
subtest "PS-5: E: wills->new()=undef, F=TRUE => croak \"Can't open the wills database\"" => sub {
	my $obj = Genealogy::Wills->new(directory => $temp_dir);
	mock 'Genealogy::Wills::wills::new' => sub { return undef };

	throws_ok(
		sub { $obj->search(last => 'Smith') },
		qr/Can't open the wills database/,
		"PS-5: croak text matches documented message"
	);

	restore_all();
};

# -----------------------------------------------------------------------
# PS-6  E: wills->new() succeeds (first call)  G=TRUE(list)  H-LOOP: 0 iters
# selectall returns [] -> for loop body never executes -> return ()
# fixate call count = 0 proves the loop body was skipped.
# -----------------------------------------------------------------------
subtest 'PS-6: first call, list context, empty result => H-LOOP 0 iters, fixate=0' => sub {
	my $obj = Genealogy::Wills->new(directory => $temp_dir);

	mock 'Genealogy::Wills::wills::new' => sub { bless {}, 'Genealogy::Wills::wills' };
	mock 'Genealogy::Wills::wills::selectall_hashref' => sub { [] };

	my $fixate_calls = 0;
	my $real_fixate  = \&Data::Reuse::fixate;
	mock 'Data::Reuse::fixate' => sub { $fixate_calls++; $real_fixate->(@_) };

	my @results = $obj->search(last => 'Nonexistent');

	is(scalar @results, 0, 'PS-6: empty list returned');
	is($fixate_calls,   0, 'PS-6: fixate=0 proves loop body never ran (0 iterations)');

	restore_all();
};

# -----------------------------------------------------------------------
# PS-7  E: wills->new() succeeds (first call)  G=TRUE(list)  H-LOOP: N iters
# selectall returns N rows -> _decorate_will called N times (via fixate count).
# -----------------------------------------------------------------------
subtest 'PS-7: first call, list context, N rows => H-LOOP N iters, all rows decorated' => sub {
	my $obj = Genealogy::Wills->new(directory => $temp_dir);

	mock 'Genealogy::Wills::wills::new' => sub { bless {}, 'Genealogy::Wills::wills' };
	mock 'Genealogy::Wills::wills::selectall_hashref' => sub {
		return [ map { +{%$_} } @MOCK_ROWS ];
	};

	my $fixate_calls = 0;
	my $real_fixate  = \&Data::Reuse::fixate;
	mock 'Data::Reuse::fixate' => sub { $fixate_calls++; $real_fixate->(@_) };

	my @results = $obj->search(last => 'Smith');

	is(scalar @results, $MOCK_ROW_COUNT, 'PS-7: all rows returned');
	is($fixate_calls,   $MOCK_ROW_COUNT, 'PS-7: fixate=N proves loop ran N times');
	like($results[0]->{'url'}, qr{^https://}, 'PS-7: first row url decorated');
	like($results[1]->{'url'}, qr{^https://}, 'PS-7: second row url decorated');

	restore_all();
};

# -----------------------------------------------------------------------
# PS-8  E: ||= no-op (wills pre-set)  G=FALSE(scalar)  I=FALSE(fetchrow=undef) -> return
# -----------------------------------------------------------------------
subtest 'PS-8: wills pre-set (||= no-op), scalar context, fetchrow=undef => return undef' => sub {
	my $obj = Genealogy::Wills->new(directory => $temp_dir);
	_inject_empty($obj);    # _PT_MockDB_Empty::fetchrow_hashref always returns undef

	my $new_calls = 0;
	mock 'Genealogy::Wills::wills::new' => sub { $new_calls++ };

	my $result = $obj->search(last => 'Nonexistent');

	is($new_calls, 0,    'PS-8: ||= short-circuited, wills::new not called');
	ok(!defined $result, 'PS-8: I=FALSE -> bare return -> undef');

	restore_all();
};

# -----------------------------------------------------------------------
# PS-9  E: ||= no-op (wills pre-set)  G=FALSE(scalar)  I=TRUE(fetchrow defined)
#        -> Return::Set::set_return -> return hashref
# -----------------------------------------------------------------------
subtest 'PS-9: wills pre-set, scalar context, fetchrow defined => Return::Set, hashref' => sub {
	my $obj = Genealogy::Wills->new(directory => $temp_dir);
	# Use the inline package so fetchrow_hashref is a real named method, not a
	# Test::Mockingbird stash entry that degrades after multiple restore_all() cycles.
	_inject_rows($obj);

	my $set_return_calls = 0;
	my $real_set_return  = \&Return::Set::set_return;