view release on metacpan or  search on metacpan

t/default_value_extraction.t  view on Meta::CPAN

		'Cleans boolean true (1)'
	);

	is(
		$extractor->_clean_default_value('0'),
		0,
		'Cleans boolean false (0)'
	);

	is(
		$extractor->_clean_default_value('true'),
		1,
		'Cleans boolean true string'
	);

	is(
		$extractor->_clean_default_value('false'),
		0,
		'Cleans boolean false string'
	);

	# Test data structures
	is_deeply(
		$extractor->_clean_default_value('[]'),
		[],
		'Cleans empty arrayref'
	);

	is_deeply(
		$extractor->_clean_default_value('{}'),
		{},
		'Cleans empty hashref'
	);

	# Test special values
	is(
		$extractor->_clean_default_value('undef'),
		undef,
		'Cleans undef'
	);

	is(
		$extractor->_clean_default_value('__PACKAGE__'),
		'__PACKAGE__',
		'Preserves __PACKAGE__ constant'
	);

	# Test with extra whitespace
	is(
		$extractor->_clean_default_value("  'test'  "),
		'test',
		'Cleans string with whitespace'
	);

	is(
		$extractor->_clean_default_value(' 42 '),
		42,
		'Cleans integer with whitespace'
	);

	# Test escaped strings
	is(
		$extractor->_clean_default_value('"line1\\nline2"'),
		"line1\nline2",
		'Handles escaped newlines'
	);

	is(
		$extractor->_clean_default_value("'it\\'s working'"),
		"it's working",
		'Handles escaped quotes'
	);

	done_testing();
};

# POD default value extraction
subtest 'POD Default Value Extraction' => sub {
	my $module = <<'END_MODULE';
package Test::PODDefaults;
use strict;
use warnings;

=head2 process_data

Process data with various parameters.

=over 4

=item * $name - string, the name to process. Default: 'anonymous'

=item * $count - integer, number of items. Default: 10

=item * $enabled - boolean, whether enabled. Default: true

=item * $mode - string, processing mode. Optional, default: 'auto'

=back

Defaults to: 1 on success

=cut

sub process_data {
	my ($self, $name, $count, $enabled, $mode) = @_;

	$name ||= 'anonymous';
	$count //= 10;
	$enabled //= 1;
	$mode = 'auto' unless defined $mode;

	return 1;
}

=head2 another_method

Another method with different POD patterns.

Parameters:
  $host - string, hostname. Defaults to: 'localhost'
  $port - integer, port number. Default: 8080
  $timeout - number, timeout in seconds. Optional, default: 30.0

=cut

sub another_method {
	my ($self, $host, $port, $timeout) = @_;

	$host ||= 'localhost';
	$port //= 8080;
	$timeout = 30.0 unless defined $timeout;

t/default_value_extraction.t  view on Meta::CPAN

		'boolean',
		'Type inferred from boolean default'
	);

	is(
		$configure_input->{timeout}{_default},
		30.0,
		'Schema includes timeout default'
	);

	is(
		$configure_input->{timeout}{type},
		'number',
		'Type inferred from float default'
	);

	# Test process method with data structures
	my $process_schema = $schemas->{process};
	my $process_input = $process_schema->{input};

	is_deeply(
		$process_input->{items}{_default},
		[],
		'Schema includes empty arrayref default'
	);

	is(
		$process_input->{items}{type},
		'arrayref',
		'Type inferred from arrayref default'
	);

	is_deeply(
		$process_input->{options}{_default},
		{},
		'Schema includes empty hashref default'
	);

	is(
		$process_input->{options}{type},
		'hashref',
		'Type inferred from hashref default'
	);

	done_testing();
};

# Edge cases and tricky patterns
subtest 'Edge Cases and Tricky Patterns' => sub {
	my $module = <<'END_MODULE';
package Test::EdgeCases;
use strict;
use warnings;

sub edge_cases {
	my ($self, $param1, $param2, $param3, $param4, $param5) = @_;

	# Edge case 1: Default with quotes inside quotes
	$param1 = $param1 || "it's complicated";

	# Edge case 2: Default with escaped characters
	$param2 //= "line1\\nline2\\ttab";

	# Edge case 3: Default as expression in parentheses
	$param3 = defined $param3 ? $param3 : (10 + 20);

	# Edge case 4: Default with trailing comment
	$param4 = $param4 || 'default';  # this is a comment

	# Edge case 5: Default with q// operator
	$param5 = $param5 || q{default value};

	return 1;
}

sub no_defaults {
	my ($self, $required) = @_;

	# No default - should be required
	die 'Required!' unless defined $required;

	return 1;
}
END_MODULE

	my $extractor = create_extractor($module);

	# Test edge case method
	my $doc = PPI::Document->new($extractor->{input_file});
	$extractor->{_document} = $doc;

	my $methods = $extractor->_find_methods($doc);
	my $edge_cases = (grep { $_->{name} eq 'edge_cases' } @$methods)[0];

	# Analyze parameters
	my $body = $edge_cases->{body};
	my $code_params = $extractor->_analyze_code($edge_cases->{body});

	# Check specific edge cases
	is(
		$code_params->{param1}{_default},
		"it's complicated",
		'Handles quotes inside string default'
	);

is(
	$code_params->{param2}{_default},
	"line1\\nline2\\ttab",
	'Preserves escaped characters in default'
);
	is(
		$code_params->{param2}{_default},
		"line1\\nline2\\ttab",
		'Preserves escaped characters in default'
	);

	# Note: param3 returns expression "(10 + 20)" which we can't evaluate
	ok(
		$code_params->{param3}{_default},
		'Extracts expression default (even if unevaluatable)'
	);

	is(
		$code_params->{param4}{_default},
		'default',
		'Ignores trailing comments in default extraction'
	);

	is(
		$code_params->{param5}{_default},
		'default value',
		'Extracts default from q{} operator'
	);

	# Test required parameter (no defaults)
	my $no_defaults = (grep { $_->{name} eq 'no_defaults' } @$methods)[0];
	my $no_defaults_params = $extractor->_analyze_code($no_defaults->{body});

	is(
		$no_defaults_params->{required}{optional},
		0,
		'Parameter without default is marked as required'
	);

	ok(
		!exists $no_defaults_params->{required}{_default},
		'Required parameter has no default value'
	);

	done_testing();
};

# Real-world example
subtest 'Real-World Example' => sub {
	my $module = <<'END_MODULE';
package Test::RealWorld;
use strict;
use warnings;

=head2 connect_to_database

Connect to a database with sensible defaults.

Parameters:
  $host - Database hostname. Default: 'localhost'
  $port - Database port. Default: 3306
  $user - Username. Optional, default: 'app_user'
  $password - Password. Optional, default: undef (no password)
  $database - Database name. Required.
  $ssl - Use SSL connection. Default: false
  $timeout - Connection timeout in seconds. Default: 10

Returns: Database connection object