view release on metacpan or  search on metacpan

t/return.t  view on Meta::CPAN

sub get_items {
	my ($self) = @_;
	my @items = qw(foo bar baz);
	return wantarray ? @items : scalar(@items);
}

=head2 fetch_data

Context-aware data fetcher.

=cut

sub fetch_data {
	my ($self) = @_;
	return unless wantarray;
	return ($self->{id}, $self->{name}, $self->{email});
}

END_MODULE

	my $extractor = create_extractor($module);
	my $schemas = $extractor->extract_all();

	my $get_items = $schemas->{get_items};
	ok($get_items->{output}{_context_aware}, 'Detects wantarray usage');
	is($get_items->{output}{_list_context}{type}, 'array', 'List context returns array');
	is($get_items->{output}{_scalar_context}{type}, 'integer', 'Scalar context returns integer');

	my $fetch_data = $schemas->{fetch_data};
	ok($fetch_data->{output}{_context_aware}, 'Detects wantarray in conditional');
	ok($fetch_data->{output}{_list_context}, 'Has list context return');

	done_testing();
};

# Void Context Methods
subtest 'Void Context Detection' => sub {
	my $module = <<'END_MODULE';
package Test::VoidContext;
use strict;
use warnings;

sub set_name {
	my ($self, $name) = @_;
	$self->{name} = $name;
	return;
}

sub add_item {
	my ($self, $item) = @_;
	push @{$self->{items}}, $item;
	return;
}

sub log_message {
	my ($self, $msg) = @_;
	print STDERR $msg;
	return;
}

sub update_status {
	my ($self, $status) = @_;
	$self->{status} = $status;
	return 1;
}

END_MODULE

	my $extractor = create_extractor($module);
	my $schemas = $extractor->extract_all();

	# Void context methods
	is($schemas->{set_name}{output}{type}, 'void', 'Setter is void context');
	ok($schemas->{set_name}{output}{_void_context_hint}, 'Detected setter pattern');

	is($schemas->{add_item}{output}{type}, 'void', 'Mutator is void context');
	ok($schemas->{add_item}{output}{_void_context_hint}, 'Detected mutator pattern');

	is($schemas->{log_message}{output}{type}, 'void', 'Logger is void context');

	# Success indicator (not void)
	is($schemas->{update_status}{output}{type}, 'boolean', 'Update returns success indicator');
	ok($schemas->{update_status}{output}{_success_indicator}, 'Detected success indicator pattern');

	done_testing();
};

# Method Chaining Detection
subtest 'Method Chaining Detection' => sub {
	my $module = <<'END_MODULE';
package Test::Chainable;
use strict;
use warnings;

=head2 set_width

Sets width. Chainable method.

Returns: self

=cut

sub set_width {
	my ($self, $width) = @_;
	$self->{width} = $width;
	return $self;
}

=head2 set_height

Fluent interface for setting height.

=cut

sub set_height {
	my ($self, $height) = @_;
	$self->{height} = $height;
	return $self;
}

sub configure {