Fixed off by one bug in estimate length

Author: nigelhorne

lib/Data/Random/String/Matches.pm

@@ -423,7 +423,7 @@ sub pattern_info {
 		has_named_groups    => ($pattern =~ /\(\?</ ? 1 : 0),
 		has_possessive      => ($pattern =~ /(?:[+*?]\+|\{\d+(?:,\d*)?\}\+)/ ? 1 : 0),
 	);
-	
+
 	return {
 		pattern             => $pattern,
 		min_length          => $min_len,
@@ -434,7 +434,6 @@ sub pattern_info {
 	};
 }
 
-# FIXME: min_length can be one too small
 sub _estimate_length {
 	my ($self, $pattern) = @_;
 
@@ -447,15 +446,23 @@ sub _estimate_length {
 	my $max = 0;
 
 	# Simple heuristic - count fixed characters and quantifiers
+	my $last_was_atom = 0;
 	while ($pattern =~ /([^+*?{}\[\]\\])|\\[dwsWDN]|\[([^\]]+)\]|\{(\d+)(?:,(\d+))?\}/g) {
 		if (defined $1 || (defined $2 && $2)) {
-			# Fixed character or character class
 			$min++;
 			$max++;
+			$last_was_atom = 1;
 		} elsif (defined $3) {
-			# Quantifier {n} or {n,m}
-			$min += $3;
-			$max += defined $4 ? $4 : $3;
+			if ($last_was_atom) {
+				# Replace the last atom’s contribution
+				$min += $3 - 1;
+				$max += (defined $4 ? $4 : $3) - 1;
+				$last_was_atom = 0;
+			} else {
+				# No preceding atom? assume standalone
+				$min += $3;
+				$max += defined $4 ? $4 : $3;
+			}
 		}
 	}
 
@@ -990,7 +997,7 @@ Nigel Horne, C<< <njh at nigelhorne.com> >>
 
 =item * L<Regexp::Genex>
 
-=end
+=back
 
 =head1 LICENCE AND COPYRIGHT
 

t/utility_methods.t

@@ -14,58 +14,58 @@ BEGIN {
 
 subtest 'set_seed - basic functionality' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{10}/);
-	
+
 	# Set seed and generate
 	$gen->set_seed(12345);
 	my $str1 = $gen->generate();
-	
+
 	# Reset seed and generate again
 	$gen->set_seed(12345);
 	my $str2 = $gen->generate();
-	
+
 	is($str1, $str2, 'Same seed produces same result');
 	like($str1, qr/^\d{10}$/, 'Generated string matches pattern');
 };
 
 subtest 'set_seed - returns self for chaining' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
 	my $result = $gen->set_seed(999);
-	
+
 	is($result, $gen, 'Returns self for method chaining');
-	
+
 	# Test chaining
 	my $str = $gen->set_seed(999)->generate();
 	like($str, qr/^\d{4}$/, 'Chaining works');
 };
 
 subtest 'set_seed - different seeds produce different results' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/[A-Z]{10}/);
-	
+
 	$gen->set_seed(111);
 	my $str1 = $gen->generate();
-	
+
 	$gen->set_seed(222);
 	my $str2 = $gen->generate();
-	
+
 	isnt($str1, $str2, 'Different seeds produce different results');
 };
 
 subtest 'set_seed - error handling' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	eval { $gen->set_seed() };
 	like($@, qr/Seed must be defined/, 'Dies without seed');
-	
+
 	eval { $gen->set_seed(undef) };
 	like($@, qr/Seed must be defined/, 'Dies with undef seed');
 };
 
 subtest 'set_seed - various seed types' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{5}/);
-	
+
 	# Numeric seed
 	ok($gen->set_seed(12345), 'Accepts numeric seed');
-	
+
 	# Zero seed
 	ok($gen->set_seed(0), 'Accepts zero as seed');
 };
@@ -76,15 +76,15 @@ subtest 'set_seed - various seed types' => sub {
 
 subtest 'validate - matching strings' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	ok($gen->validate('1234'), 'Valid 4-digit string');
 	ok($gen->validate('0000'), 'Valid with zeros');
 	ok($gen->validate('9999'), 'Valid with nines');
 };
 
 subtest 'validate - non-matching strings' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	ok(!$gen->validate('123'), 'Too short');
 	ok(!$gen->validate('12345'), 'Too long');
 	ok(!$gen->validate('abcd'), 'Wrong characters');
@@ -93,7 +93,7 @@ subtest 'validate - non-matching strings' => sub {
 
 subtest 'validate - complex patterns' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/[A-Z]{3}-\d{4}/);
-	
+
 	ok($gen->validate('ABC-1234'), 'Valid complex pattern');
 	ok(!$gen->validate('ABC1234'), 'Missing dash');
 	ok(!$gen->validate('abc-1234'), 'Wrong case');
@@ -102,7 +102,7 @@ subtest 'validate - complex patterns' => sub {
 
 subtest 'validate - with alternation' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/(cat|dog|bird)/);
-	
+
 	ok($gen->validate('cat'), 'First alternative');
 	ok($gen->validate('dog'), 'Second alternative');
 	ok($gen->validate('bird'), 'Third alternative');
@@ -111,7 +111,7 @@ subtest 'validate - with alternation' => sub {
 
 subtest 'validate - with backreferences' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/(\w{3})-\1/);
-	
+
 	ok($gen->validate('abc-abc'), 'Valid backreference');
 	ok($gen->validate('XYZ-XYZ'), 'Valid uppercase backreference');
 	ok(!$gen->validate('abc-xyz'), 'Backreference mismatch');
@@ -120,17 +120,17 @@ subtest 'validate - with backreferences' => sub {
 
 subtest 'validate - error handling' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	eval { $gen->validate() };
 	like($@, qr/String must be defined/, 'Dies without string');
-	
+
 	eval { $gen->validate(undef) };
 	like($@, qr/String must be defined/, 'Dies with undef');
 };
 
 subtest 'validate - special cases' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	ok($gen->validate('0000'), 'All zeros valid');
 	ok(!$gen->validate(''), 'Empty string invalid');
 	ok(!$gen->validate(' 1234'), 'Leading space invalid');
@@ -139,7 +139,7 @@ subtest 'validate - special cases' => sub {
 
 subtest 'validate - generated strings always validate' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/[A-Z0-9]{8}/);
-	
+
 	for (1..10) {
 		my $str = $gen->generate();
 		ok($gen->validate($str), "Generated string validates: $str");
@@ -153,10 +153,10 @@ subtest 'validate - generated strings always validate' => sub {
 subtest 'pattern_info - basic structure' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
 	my $info = $gen->pattern_info();
-	
+
 	ok(defined $info, 'Returns defined value');
 	is(ref($info), 'HASH', 'Returns hashref');
-	
+
 	# Check required keys
 	ok(exists $info->{pattern}, 'Has pattern key');
 	ok(exists $info->{min_length}, 'Has min_length key');
@@ -169,7 +169,7 @@ subtest 'pattern_info - basic structure' => sub {
 subtest 'pattern_info - simple pattern' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
 	my $info = $gen->pattern_info();
-	
+
 	is($info->{pattern}, '(?^:\d{4})', 'Pattern stored correctly');
 	cmp_ok($info->{min_length}, '>=', 4, 'Min length reasonable');
 	ok($info->{max_length} >= 4, 'Max length reasonable');
@@ -181,22 +181,22 @@ subtest 'pattern_info - features detection' => sub {
 	my $gen1 = Data::Random::String::Matches->new(qr/(cat|dog)/);
 	my $info1 = $gen1->pattern_info();
 	ok($info1->{features}{has_alternation}, 'Detects alternation');
-	
+
 	# Backreferences
 	my $gen2 = Data::Random::String::Matches->new(qr/(\w{3})-\1/);
 	my $info2 = $gen2->pattern_info();
 	ok($info2->{features}{has_backreferences}, 'Detects backreferences');
-	
+
 	# Unicode
 	my $gen3 = Data::Random::String::Matches->new(qr/\p{L}{5}/);
 	my $info3 = $gen3->pattern_info();
 	ok($info3->{features}{has_unicode}, 'Detects Unicode properties');
-	
+
 	# Named groups
 	my $gen4 = Data::Random::String::Matches->new(qr/(?<id>\d{3})/);
 	my $info4 = $gen4->pattern_info();
 	ok($info4->{features}{has_named_groups}, 'Detects named groups');
-	
+
 	# Possessive
 	my $gen5 = Data::Random::String::Matches->new(qr/\d++/);
 	my $info5 = $gen5->pattern_info();
@@ -209,7 +209,7 @@ subtest 'pattern_info - length estimation' => sub {
 	my $info1 = $gen1->pattern_info();
 	ok($info1->{min_length} <= 5, 'Min length <= 5');
 	ok($info1->{max_length} >= 5, 'Max length >= 5');
-	
+
 	# Variable length
 	my $gen2 = Data::Random::String::Matches->new(qr/\d{3,7}/);
 	my $info2 = $gen2->pattern_info();
@@ -221,7 +221,7 @@ subtest 'pattern_info - complexity levels' => sub {
 	# Simple
 	my $gen1 = Data::Random::String::Matches->new(qr/\d{4}/);
 	is($gen1->pattern_info()->{complexity}, 'simple', 'Simple pattern');
-	
+
 	# Complex (with multiple features)
 	my $gen2 = Data::Random::String::Matches->new(qr/(?<id>\d{3})-(\w+)-\k<id>|[A-Z]{10}/);
 	my $complexity = $gen2->pattern_info()->{complexity};
@@ -231,19 +231,17 @@ subtest 'pattern_info - complexity levels' => sub {
 subtest 'pattern_info - estimated length' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{3,7}/);
 	my $info = $gen->pattern_info();
-	
-	ok($info->{estimated_length} >= $info->{min_length}, 
-	   'Estimated >= min');
-	ok($info->{estimated_length} <= $info->{max_length}, 
-	   'Estimated <= max');
+
+	ok($info->{estimated_length} >= $info->{min_length}, 'Estimated >= min');
+	ok($info->{estimated_length} <= $info->{max_length}, 'Estimated <= max');
 };
 
 subtest 'pattern_info - features hash structure' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
 	my $features = $gen->pattern_info()->{features};
-	
+
 	is(ref($features), 'HASH', 'Features is a hashref');
-	
+
 	# Check all expected feature keys exist
 	ok(exists $features->{has_alternation}, 'has_alternation key');
 	ok(exists $features->{has_backreferences}, 'has_backreferences key');
@@ -257,7 +255,7 @@ subtest 'pattern_info - features hash structure' => sub {
 subtest 'pattern_info - no features in simple pattern' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/[A-Z]{5}/);
 	my $features = $gen->pattern_info()->{features};
-	
+
 	ok(!$features->{has_alternation}, 'No alternation');
 	ok(!$features->{has_backreferences}, 'No backreferences');
 	ok(!$features->{has_unicode}, 'No unicode');
@@ -270,19 +268,19 @@ subtest 'pattern_info - no features in simple pattern' => sub {
 
 subtest 'Integration - set_seed with generate_many' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	$gen->set_seed(42);
 	my @batch1 = $gen->generate_many(5);
-	
+
 	$gen->set_seed(42);
 	my @batch2 = $gen->generate_many(5);
-	
+
 	is_deeply(\@batch1, \@batch2, 'Seeded generate_many is reproducible');
 };
 
 subtest 'Integration - validate with generate' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/[A-Z]{3}\d{4}/);
-	
+
 	for (1..20) {
 		my $str = $gen->generate();
 		ok($gen->validate($str), "Generated string $str validates");
@@ -292,35 +290,35 @@ subtest 'Integration - validate with generate' => sub {
 subtest 'Integration - pattern_info accuracy check' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/[A-Z]{3}\d{4}/);
 	my $info = $gen->pattern_info();
-	
+
 	# Generate several strings and check lengths
 	for (1..10) {
 		my $str = $gen->generate();
 		my $len = length($str);
-		
+
 		ok($len >= $info->{min_length}, "Length $len >= min $info->{min_length}");
 		ok($len <= $info->{max_length}, "Length $len <= max $info->{max_length}");
 	}
 };
 
 subtest 'Integration - all methods together' => sub {
 	my $gen = Data::Random::String::Matches->new(qr/\d{4}/);
-	
+
 	# Get info
 	my $info = $gen->pattern_info();
 	ok($info->{complexity}, 'Got pattern info');
-	
+
 	# Set seed for reproducibility
 	$gen->set_seed(123);
-	
+
 	# Generate and validate
 	my $str = $gen->generate();
 	ok($gen->validate($str), 'Generated and validated');
-	
+
 	# Generate many
 	my @many = $gen->generate_many(5);
 	is(scalar @many, 5, 'Generated many');
-	
+
 	# Validate all
 	for my $s (@many) {
 		ok($gen->validate($s), "Batch string validates: $s");