Skip to content

Commit fdb4651

Browse files
nigelhornenigelhorne
committed
Added t/release04.t
1 parent 3385db3 commit fdb4651

File tree

2 files changed

+255
-0
lines changed

2 files changed

+255
-0
lines changed

‎MANIFEST‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,5 +24,6 @@ t/generate.t
2424
t/pod-cm.t
2525
t/pod-synopsis.t
2626
t/pod.t
27+
t/release04.t
2728
t/suggest.t
2829
t/utility_methods.t

‎t/release04.t‎

Lines changed: 254 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,254 @@
1+
#!/usr/bin/env perl
2+
3+
use strict;
4+
use warnings;
5+
use Test::More;
6+
7+
BEGIN {
8+
use_ok('Data::Random::String::Matches');
9+
}
10+
11+
# ===========================================================================
12+
# Regression test for quote handling in character classes
13+
# Issue: Argument "#" isn't numeric in range (or flop)
14+
# Pattern: qr/^[!#-'*+\\-\\.\\^_`|~0-9A-Za-z]+$/
15+
# ===========================================================================
16+
17+
subtest 'Character class with single quotes in range' => sub {
18+
# The problematic pattern that caused the original error
19+
my $gen = Data::Random::String::Matches->new(qr/^[!#-'*+\\-\\.\\^_`|~0-9A-Za-z]+$/);
20+
21+
# Should not die
22+
my $str;
23+
eval {
24+
$str = $gen->generate();
25+
};
26+
27+
ok(!$@, 'Generates without error') or diag("Error: $@");
28+
ok(defined $str, 'Generated string is defined');
29+
30+
if (defined $str) {
31+
# Verify it matches the pattern
32+
like($str, qr/^[!#-'*+\\-\\.\\^_`|~0-9A-Za-z]+$/, 'Generated string matches pattern');
33+
34+
# Check that string contains valid characters
35+
my @chars = split //, $str;
36+
for my $char (@chars) {
37+
my $ord = ord($char);
38+
# Valid ranges: ! (33), #-' (35-39), * (42), + (43), - (45), . (46),
39+
# ^ (94), _ (95), ` (96), | (124), ~ (126), 0-9 (48-57), A-Z (65-90), a-z (97-122)
40+
ok(
41+
$char =~ /[!#-'*+\-\.\^_`|~0-9A-Za-z]/,
42+
"Character '$char' (ord $ord) is valid"
43+
);
44+
}
45+
}
46+
};
47+
48+
subtest 'Character class with range starting after quote' => sub {
49+
# Range #-' includes: # $ % & '
50+
my $gen = Data::Random::String::Matches->new(qr/[#-']/);
51+
52+
my $str = $gen->generate();
53+
ok(defined $str, 'Generated string defined');
54+
like($str, qr/^[#-']$/, 'Matches range #-\'');
55+
56+
# Verify it's one of the expected characters
57+
ok($str =~ /^[#\$%&']$/, "Character is in range: $str");
58+
};
59+
60+
subtest 'Character class with quote as range end' => sub {
61+
# Test various ranges ending in quotes
62+
my @test_patterns = (
63+
qr/[!-']/, # ! " # $ % & '
64+
qr/["-']/, # " # $ % & '
65+
qr/[#-']/, # # $ % & '
66+
);
67+
68+
for my $pattern (@test_patterns) {
69+
my $gen = Data::Random::String::Matches->new($pattern);
70+
my $str = $gen->generate();
71+
72+
ok(defined $str, "Pattern $pattern generates successfully");
73+
like($str, $pattern, 'Generated string matches pattern');
74+
}
75+
};
76+
77+
subtest 'Character class with double quotes in range' => sub {
78+
# Range with double quotes
79+
my $gen = Data::Random::String::Matches->new(qr/[!-"]/);
80+
81+
my $str = $gen->generate();
82+
ok(defined $str, 'Generated with double quote range');
83+
like($str, qr/^[!-"]$/, 'Matches range with double quote');
84+
85+
# Should be ! or "
86+
ok($str eq '!' || $str eq '"', "Character is ! or \": got '$str'");
87+
};
88+
89+
subtest 'Character class with backtick' => sub {
90+
# Backtick in character class
91+
my $gen = Data::Random::String::Matches->new(qr/[_`a]/);
92+
93+
my $str = $gen->generate();
94+
ok(defined $str, 'Generated with backtick');
95+
like($str, qr/^[_`a]$/, 'Matches pattern with backtick');
96+
97+
ok($str =~ /^[_`a]$/, "Character is valid: $str");
98+
};
99+
100+
subtest 'Character class with escaped special chars' => sub {
101+
# Pattern with escaped special characters
102+
my $gen = Data::Random::String::Matches->new(qr/[a\-z]/);
103+
104+
my $str = $gen->generate();
105+
ok(defined $str, 'Generated with escaped dash');
106+
107+
# Should be 'a', '-', or 'z' (not a range because dash is escaped)
108+
ok($str =~ /^[az\-]$/, "Character is a, z, or dash: $str");
109+
};
110+
111+
subtest 'Character class with multiple quote types' => sub {
112+
# Mix of single and double quotes
113+
my $gen = Data::Random::String::Matches->new(qr/["'`]/);
114+
115+
my $str = $gen->generate();
116+
ok(defined $str, 'Generated with multiple quote types');
117+
ok($str eq '"' || $str eq "'" || $str eq '`',
118+
"Character is a quote type: $str");
119+
};
120+
121+
subtest 'Complex character class from original error' => sub {
122+
# Full pattern that caused the error
123+
my $pattern = qr/^[!#-'*+\\-\\.\\^_`|~0-9A-Za-z]+$/;
124+
my $gen = Data::Random::String::Matches->new($pattern);
125+
126+
# Generate multiple times to ensure consistency
127+
for my $i (1..10) {
128+
my $str = $gen->generate();
129+
ok(defined $str, "Iteration $i: Generated successfully");
130+
like($str, $pattern, "Iteration $i: Matches pattern");
131+
ok(length($str) > 0, "Iteration $i: Non-empty string");
132+
}
133+
};
134+
135+
subtest 'Character class range boundaries with quotes' => sub {
136+
# Test ranges that include quote characters at boundaries
137+
my @test_cases = (
138+
{
139+
pattern => qr/[!-']/,
140+
desc => 'Range from ! to \'',
141+
chars => ['!', '"', '#', '$', '%', '&', "'"],
142+
},
143+
{
144+
pattern => qr/['-*]/,
145+
desc => 'Range from \' to *',
146+
chars => ["'", '(', ')', '*'],
147+
},
148+
);
149+
150+
for my $test (@test_cases) {
151+
my $gen = Data::Random::String::Matches->new($test->{pattern});
152+
153+
# Generate multiple strings
154+
my %seen;
155+
for (1..50) {
156+
my $str = $gen->generate();
157+
$seen{$str}++;
158+
}
159+
160+
# Check we only got valid characters
161+
for my $char (keys %seen) {
162+
ok(
163+
(grep { $_ eq $char } @{$test->{chars}}),
164+
"$test->{desc}: Character '$char' is valid"
165+
);
166+
}
167+
168+
# Should have some variety (at least 2 different chars in 50 tries)
169+
cmp_ok(scalar keys %seen, '>=', 2,
170+
"$test->{desc}: Generated variety");
171+
}
172+
};
173+
174+
subtest 'Escaped vs unescaped dash in character class' => sub {
175+
# Escaped dash: literal dash character
176+
my $gen1 = Data::Random::String::Matches->new(qr/[a\-z]/);
177+
my %chars1;
178+
$chars1{$gen1->generate()}++ for (1..30);
179+
180+
# Should only see a, -, z (not b, c, d, etc.)
181+
for my $char (keys %chars1) {
182+
ok($char =~ /^[az\-]$/, "Escaped dash pattern: got '$char'");
183+
}
184+
185+
# Unescaped dash: range
186+
my $gen2 = Data::Random::String::Matches->new(qr/[a-z]/);
187+
my %chars2;
188+
$chars2{$gen2->generate()}++ for (1..30);
189+
190+
# Should see variety of lowercase letters
191+
ok(scalar(keys %chars2) >= 5,
192+
'Unescaped dash creates range with variety');
193+
};
194+
195+
subtest 'Validate pattern_info with quotes' => sub {
196+
# Ensure pattern_info doesn't crash on these patterns
197+
my $gen = Data::Random::String::Matches->new(qr/^[!#-'*+\\-\\.\\^_`|~0-9A-Za-z]+$/);
198+
199+
my $info;
200+
eval {
201+
$info = $gen->pattern_info();
202+
};
203+
204+
ok(!$@, 'pattern_info does not crash') or diag("Error: $@");
205+
ok(defined $info, 'pattern_info returns defined value');
206+
207+
if (defined $info) {
208+
ok(exists $info->{min_length}, 'Has min_length');
209+
ok(exists $info->{max_length}, 'Has max_length');
210+
ok(exists $info->{complexity}, 'Has complexity');
211+
}
212+
};
213+
214+
subtest 'Generate many with quote patterns' => sub {
215+
my $gen = Data::Random::String::Matches->new(qr/[!#-']/);
216+
217+
# Pattern [!#-'] has 6 possible characters: ! " # $ % & '
218+
# So we can only generate at most 6 unique single-char strings
219+
my @strings = $gen->generate_many(6, 1);
220+
221+
cmp_ok(scalar @strings, '>=', 5, 'Generated at least 5 unique strings')
222+
or diag('Only got ', scalar(@strings));
223+
cmp_ok(scalar @strings, '<=', 6, 'Generated at most 6 unique strings (the maximum possible)');
224+
225+
# All should match
226+
for my $str (@strings) {
227+
like($str, qr/^[!#-']$/, "String '$str' matches pattern");
228+
}
229+
230+
# Check uniqueness
231+
my %seen;
232+
for my $str (@strings) {
233+
ok(!$seen{$str}, "String '$str' is unique");
234+
$seen{$str}++;
235+
}
236+
};
237+
238+
subtest 'Validate with quote patterns' => sub {
239+
my $gen = Data::Random::String::Matches->new(qr/[#-']/);
240+
241+
# Test valid characters in range
242+
ok($gen->validate('#'), 'Validates #');
243+
ok($gen->validate('$'), 'Validates $');
244+
ok($gen->validate('%'), 'Validates %');
245+
ok($gen->validate('&'), 'Validates &');
246+
ok($gen->validate("'"), 'Validates \'');
247+
248+
# Test invalid characters
249+
ok(!$gen->validate('!'), 'Rejects !');
250+
ok(!$gen->validate('('), 'Rejects (');
251+
ok(!$gen->validate('a'), 'Rejects a');
252+
};
253+
254+
done_testing();

0 commit comments

Comments
 (0)