line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::LectroTest::Generator; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$Test::LectroTest::Generator::VERSION = '0.5001'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
|
6
|
6
|
|
|
6
|
|
86345
|
use strict; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
216
|
|
7
|
6
|
|
|
6
|
|
29
|
use warnings; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
153
|
|
8
|
|
|
|
|
|
|
|
9
|
6
|
|
|
6
|
|
35
|
use Carp; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
481
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
BEGIN { |
12
|
6
|
|
|
6
|
|
31
|
use Exporter (); |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
994
|
|
13
|
6
|
|
|
6
|
|
17
|
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
14
|
|
|
|
|
|
|
|
15
|
6
|
|
|
|
|
19
|
my @gens = qw( &Int &Bool &Char &String &List &Hash |
16
|
|
|
|
|
|
|
&Float &Elements &Unit ); |
17
|
6
|
|
|
|
|
17
|
my @combs = qw( &Paste &OneOf &Frequency &Sized &Each |
18
|
|
|
|
|
|
|
&Apply &Map |
19
|
|
|
|
|
|
|
&Concat &Flatten &ConcatMap &FlattenMap ); |
20
|
6
|
|
|
|
|
10
|
my @specials = qw( &Gen) ; |
21
|
|
|
|
|
|
|
|
22
|
6
|
|
|
|
|
95
|
@ISA = qw(Exporter); |
23
|
6
|
|
|
|
|
55
|
@EXPORT = (); |
24
|
6
|
|
|
|
|
33
|
@EXPORT_OK = ( @gens, @combs, @specials); |
25
|
6
|
|
|
|
|
19754
|
%EXPORT_TAGS = ( common => [@gens] |
26
|
|
|
|
|
|
|
, combinators => [@combs] |
27
|
|
|
|
|
|
|
, all => [@gens, @combs, @specials] ); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
our @EXPORT_OK; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 NAME |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Test::LectroTest::Generator - Random value generators and combinators |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 VERSION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
version 0.5001 |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 SYNOPSIS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use Test::LectroTest::Generator qw(:common :combinators); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $int_gen = Int; |
45
|
|
|
|
|
|
|
my $pct_gen = Int( range=>[0,100] ); |
46
|
|
|
|
|
|
|
my $flt_gen = Float( range=>[0,1] ); |
47
|
|
|
|
|
|
|
my $bln_gen = Bool; |
48
|
|
|
|
|
|
|
my $chr_gen = Char( charset=>"a-z" ); |
49
|
|
|
|
|
|
|
my $str_gen = String( charset=>"A-Z0-9", length=>[3,] ); |
50
|
|
|
|
|
|
|
my $ary_gen = List( Int(sized=>0) ); |
51
|
|
|
|
|
|
|
my $hsh_gen = Hash( $str_gen, $pct_gen ); |
52
|
|
|
|
|
|
|
my $uni_gen = Unit( "e" ); # always returns "e" |
53
|
|
|
|
|
|
|
my $elm_gen = Elements("e1", "e2", "e3", "e4"); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
for my $sizing_guidance (1..100) { |
56
|
|
|
|
|
|
|
my $i = $int_gen->generate( $sizing_guidance ); |
57
|
|
|
|
|
|
|
print "$i "; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
print "\n"; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# generates single digits |
62
|
|
|
|
|
|
|
my $digit_gen = Elements( 0..9 ); # or Int(range=>[0,9],sized=>0) |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# generates SSNs like "910-77-2236" |
65
|
|
|
|
|
|
|
my $ssn_gen = Paste( Paste( ($digit_gen) x 3 ), |
66
|
|
|
|
|
|
|
Paste( ($digit_gen) x 2 ), |
67
|
|
|
|
|
|
|
Paste( ($digit_gen) x 4 ), |
68
|
|
|
|
|
|
|
glue => "-" ); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# print 10 SSNs |
71
|
|
|
|
|
|
|
print( map {$ssn_gen->generate($_)."\n"} 1..10 ); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $english_dist_vowel_gen = |
74
|
|
|
|
|
|
|
Frequency( [8.167,Unit("a")], [12.702,Unit("e")], |
75
|
|
|
|
|
|
|
[6.996,Unit("i")], [ 7.507,Unit("o")], |
76
|
|
|
|
|
|
|
[2.758,Unit("u")] ); |
77
|
|
|
|
|
|
|
# Source: http://www.csm.astate.edu/~rossa/datasec/frequency.html |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head1 DESCRIPTION |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
This module provides random value generators for common data types and |
82
|
|
|
|
|
|
|
provides an interface and tools for creating your own generators. It |
83
|
|
|
|
|
|
|
also provides generator combinators that can be used to create |
84
|
|
|
|
|
|
|
more-complex generators by combining simple ones. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
A generator is an object having a method C, which takes a |
88
|
|
|
|
|
|
|
single argument, I and returns a new random value. The |
89
|
|
|
|
|
|
|
generated value is always a scalar. Generators that produce data |
90
|
|
|
|
|
|
|
structures return references to them. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head2 Sizing guidance |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
The C method interprets its I argument as guidance |
95
|
|
|
|
|
|
|
about the complexity of the value it should create. Typically, |
96
|
|
|
|
|
|
|
smaller I values result in smaller generated numbers and shorter |
97
|
|
|
|
|
|
|
generated strings and lists. Some generators, for which sizing |
98
|
|
|
|
|
|
|
doesn't make sense, ignore sizing guidance altogether; those that do |
99
|
|
|
|
|
|
|
use sizing guidance can be told to ignore it via the B |
100
|
|
|
|
|
|
|
modifier. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
The purpose of sizing is to allow LectroTest to generate simple values |
103
|
|
|
|
|
|
|
at first and then, as testing progresses, to slowly ramp up the |
104
|
|
|
|
|
|
|
complexity. In this way, counterexamples for obvious problems |
105
|
|
|
|
|
|
|
will be easier for you to understand. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
#============================================================================== |
112
|
|
|
|
|
|
|
# modifier defaults |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
our %defaults = ( |
116
|
|
|
|
|
|
|
Int => { range => [-32768 , 32767 ], sized => 1 }, |
117
|
|
|
|
|
|
|
Float => { range => [-32768.0, 32767.0], sized => 1 }, |
118
|
|
|
|
|
|
|
List => { length => undef }, |
119
|
|
|
|
|
|
|
Char => { charset => "\x00-\x7f", }, |
120
|
|
|
|
|
|
|
String => { }, |
121
|
|
|
|
|
|
|
Paste => { glue => "" }, |
122
|
|
|
|
|
|
|
); |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#============================================================================== |
125
|
|
|
|
|
|
|
# methods |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub new { |
128
|
3157
|
|
|
3157
|
0
|
3145
|
my $class = shift; |
129
|
3157
|
|
|
|
|
72126
|
return bless { @_ }, $class; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub generate { |
133
|
7389820
|
|
|
7389820
|
0
|
12287194
|
my ($self, $size) = @_; |
134
|
7389820
|
|
|
|
|
11478489
|
return scalar $self->{generator}->($size); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
#============================================================================== |
138
|
|
|
|
|
|
|
# helpers |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub _defargs { |
141
|
349
|
|
|
349
|
|
862
|
my $gen_name = shift; |
142
|
349
|
|
|
|
|
1335
|
shift while ref($_[0]); # skip template, if any |
143
|
349
|
|
|
|
|
530
|
return { %{$defaults{$gen_name}}, @_ }; |
|
349
|
|
|
|
|
2204
|
|
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _template { |
147
|
135
|
|
|
135
|
|
203
|
my $tmpl = []; |
148
|
135
|
|
|
|
|
693
|
push @$tmpl, shift while ref($_[0]); |
149
|
135
|
|
|
|
|
458
|
return $tmpl; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
#============================================================================== |
154
|
|
|
|
|
|
|
# plain old functions |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub Gen(&) { |
157
|
3157
|
|
|
3157
|
0
|
4050
|
my ($genfn) = @_; |
158
|
3157
|
|
|
|
|
6740
|
return Test::LectroTest::Generator->new(generator=>$genfn); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=pod |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 Generators |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
The following functions create fully-formed generators, ready to use. |
166
|
|
|
|
|
|
|
These functions are exported into your code's namespace if you ask for |
167
|
|
|
|
|
|
|
C<:generators> or C<:all> when you C |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Each generator has a C method that you can call to extract |
170
|
|
|
|
|
|
|
a new, random value from the generator. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=over 4 |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item Int |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my $gen = Int( range=>[0,9], sized=>0 ); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Creates a generator for integer values, by default in the range [-32768,32767], |
179
|
|
|
|
|
|
|
inclusive, but this can be changed via the optional B modifier. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=over 4 |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item Int( range=>[I, I] ) |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Causes the generated values to be constrained to the range [I, |
186
|
|
|
|
|
|
|
I], inclusive. By default, the range is [-32768, 32767]. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
B If your range is empty (i.e., I E I), |
189
|
|
|
|
|
|
|
LectroTest will complain. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
B If zero is not within the range you provide, sizing makes no |
192
|
|
|
|
|
|
|
sense because the intersection of your range and the sizing range can |
193
|
|
|
|
|
|
|
be empty, and thus you must turn off sizing with C0>. |
194
|
|
|
|
|
|
|
If you forget, LectroTest will complain. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=item Int( sized=>I ) |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
If true (the default), constrains the absolute value of the generated |
200
|
|
|
|
|
|
|
integers to the sizing guidance provided to the C method. |
201
|
|
|
|
|
|
|
Otherwise, the generated values are constrained only by the range. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=back |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=cut |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub Int(@) { |
210
|
117
|
|
|
117
|
1
|
359800
|
my $args = _defargs("Int", @_); |
211
|
117
|
|
|
|
|
376
|
my ($sized, $rlo, $rhi) = ($args->{sized}, map int, @{$args->{range}}); |
|
117
|
|
|
|
|
498
|
|
212
|
117
|
100
|
|
|
|
828
|
croak "range=>[$rlo,$rhi] is empty" if $rlo > $rhi; |
213
|
115
|
100
|
|
|
|
338
|
if (!$sized) { |
214
|
|
|
|
|
|
|
# if unsized, use this simpler generator |
215
|
65
|
|
|
|
|
137
|
my $span = $rhi - $rlo + 1; |
216
|
|
|
|
|
|
|
return Gen { |
217
|
1694680
|
|
|
1694680
|
|
4323967
|
return $rlo + int(rand($span)); |
218
|
65
|
|
|
|
|
375
|
}; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
# otherwise, provide a sizing-capable generator |
221
|
50
|
100
|
100
|
|
|
715
|
croak "the given range=>[$rlo,$rhi] does not contain zero " |
222
|
|
|
|
|
|
|
. "and cannot be used with a sized generator" |
223
|
|
|
|
|
|
|
if 0 < $rlo || 0 > $rhi; |
224
|
|
|
|
|
|
|
return Gen { |
225
|
173512
|
|
|
173512
|
|
224105
|
my ($lo, $hi) = ($rlo, $rhi); |
226
|
173512
|
|
|
|
|
209375
|
my $size = shift; |
227
|
173512
|
100
|
|
|
|
373848
|
if (defined $size) { |
228
|
103512
|
|
|
|
|
118136
|
$size = int( $size + 0.5 ); |
229
|
103512
|
100
|
|
|
|
209329
|
$lo = -$size if -$size > $lo; |
230
|
103512
|
100
|
|
|
|
182076
|
$hi = $size if $size < $hi; |
231
|
|
|
|
|
|
|
} |
232
|
173512
|
|
|
|
|
650685
|
return $lo + int(rand($hi - $lo + 1)); |
233
|
48
|
|
|
|
|
316
|
}; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=pod |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item Float |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
my $gen = Float( range=>[-2.0,2.0], sized=>1 ); |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Creates a generator for floating-point values, by default in the range |
243
|
|
|
|
|
|
|
[-32768.0,32768.0), but this can be changed via the optional B modifier. |
244
|
|
|
|
|
|
|
By default Float generators are sized. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=over 4 |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item Float( range=>[I, I] ) |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Causes the generated values to be constrained to the range [I, |
251
|
|
|
|
|
|
|
I). By default, the range is [-32768.0,32768.0). (Note that |
252
|
|
|
|
|
|
|
the I value itself can never be generated, but values |
253
|
|
|
|
|
|
|
infinitesimally close to it can.) |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
B If your range is empty (i.e., I E I), |
257
|
|
|
|
|
|
|
LectroTest will complain. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
B If zero is not within the range you provide, sizing makes no |
260
|
|
|
|
|
|
|
sense because the intersection of your range and the sizing range can |
261
|
|
|
|
|
|
|
be empty, and thus you must turn off sizing with C0>. |
262
|
|
|
|
|
|
|
If you forget, LectroTest will complain. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=item Float( sized=>I ) |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
If true (the default), constrains the absolute value of the generated |
267
|
|
|
|
|
|
|
values to the sizing guidance provided to the C method. |
268
|
|
|
|
|
|
|
Otherwise, the generated values are constrained only by the range. |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=back |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=cut |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub Float(@) { |
275
|
45
|
|
|
45
|
1
|
272141
|
my $args = _defargs("Float", @_); |
276
|
45
|
|
|
|
|
138
|
my ($sized, $rlo, $rhi) = ($args->{sized}, @{$args->{range}}); |
|
45
|
|
|
|
|
157
|
|
277
|
45
|
100
|
|
|
|
565
|
croak "range=>[$rlo,$rhi] is empty" if $rlo > $rhi; |
278
|
43
|
100
|
|
|
|
138
|
if (!$sized) { |
279
|
|
|
|
|
|
|
# if unsized, use this simpler generator |
280
|
14
|
|
|
|
|
25
|
my $span = $rhi - $rlo; |
281
|
|
|
|
|
|
|
return Gen { |
282
|
140007
|
|
|
140007
|
|
353238
|
return $rlo + rand($span); |
283
|
14
|
|
|
|
|
108
|
}; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
# otherwise, provide a sizing-capable generator |
286
|
29
|
100
|
100
|
|
|
586
|
croak "the given range [$rlo,$rhi] does not contain zero " |
287
|
|
|
|
|
|
|
. "and cannot be used with a sized generator" |
288
|
|
|
|
|
|
|
if $rlo > 0 || 0 > $rhi; |
289
|
|
|
|
|
|
|
return Gen { |
290
|
173976
|
|
|
173976
|
|
220880
|
my ($lo, $hi) = ($rlo, $rhi); |
291
|
173976
|
|
|
|
|
177338
|
my $size = shift; |
292
|
173976
|
100
|
|
|
|
320887
|
if (defined $size) { |
293
|
103976
|
100
|
|
|
|
200112
|
$lo = -$size if -$size > $lo; |
294
|
103976
|
100
|
|
|
|
195994
|
$hi = $size if $size < $hi; |
295
|
|
|
|
|
|
|
} |
296
|
173976
|
|
|
|
|
554575
|
return $lo + rand($hi - $lo); |
297
|
27
|
|
|
|
|
217
|
}; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=pod |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=item Bool |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my $gen = Bool; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Creates a generator for boolean values: 0 for false, 1 for true. |
307
|
|
|
|
|
|
|
The generator ignores sizing guidance. |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=cut |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub Bool(@) { |
312
|
5
|
|
|
5
|
1
|
2646
|
return Int( @_, range=>[0,1], sized=>0 ); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=pod |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=item Char |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my $gen = Char( charset=>"A-Za-z0-9_" ); |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Creates a generator for characters. By default the characters are in |
322
|
|
|
|
|
|
|
the ASCII range [0,127], inclusive, but this behavior can be changed |
323
|
|
|
|
|
|
|
with the B modifier: |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=over 4 |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=item Char( charset=>I ) |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Characters will be drawn from the character set given by the |
330
|
|
|
|
|
|
|
character-set specification I. The syntax of I is |
331
|
|
|
|
|
|
|
similar the Perl C |
built-in and is a string comprised of
332
|
|
|
|
|
|
|
characters and character ranges: |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=over 4 |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=item I |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
Adds the character I to the set. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=item I-I |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Adds the characters in the range I through I (inclusive) to the |
343
|
|
|
|
|
|
|
set. Note: If I is lexicographically greater than I, the range |
344
|
|
|
|
|
|
|
is empty, and no characters will be added to the set. |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=back |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Examples: |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=over 4 |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=item charset=>"abcdwxyz" |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
The characters "a", "b", "c", "d", "w", "x", "y", and "z" are in the set. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=item charset=>"a-dx-z" |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Shorter version of the previous example. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=item charset=>"\x00-\x7f" |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
The ASCII character set. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=item charset=>"-_A-Za-z0-9" |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
The character set contains "-", "_", upper- and lower-case |
367
|
|
|
|
|
|
|
ASCII letters, and the digits 0-9. Notice that the dash must |
368
|
|
|
|
|
|
|
occur first so that it is not misinterpreted as denoting |
369
|
|
|
|
|
|
|
a range of characters. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=back |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=back |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub _to_range($) { |
378
|
42
|
|
|
42
|
|
77
|
my ($lo, $hi) = @{shift()}[0,1]; |
|
42
|
|
|
|
|
117
|
|
379
|
42
|
|
|
|
|
256
|
[ map {chr} ord$lo .. ord $hi ] |
|
2474
|
|
|
|
|
4423
|
|
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
sub _parse_charset($) { |
383
|
34
|
|
|
34
|
|
88
|
local ($_) = @_; |
384
|
34
|
|
|
|
|
80
|
my @ranges; |
385
|
34
|
|
|
|
|
212
|
while (/(.)(?:-(.))?/sg) { |
386
|
42
|
100
|
|
|
|
272
|
push @ranges, [$1, defined $2 ? $2 : $1]; |
387
|
|
|
|
|
|
|
} |
388
|
34
|
|
|
|
|
89
|
[ sort keys %{{ map {($_,1)} map {@{_to_range($_)}} @ranges }} ] |
|
34
|
|
|
|
|
147
|
|
|
2474
|
|
|
|
|
5828
|
|
|
42
|
|
|
|
|
66
|
|
|
42
|
|
|
|
|
123
|
|
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub Char(@) { |
392
|
34
|
|
|
34
|
1
|
89982
|
my $cset = _defargs("Char", @_)->{charset}; |
393
|
34
|
|
|
|
|
82
|
return Elements( @{ _parse_charset($cset) } ) |
|
34
|
|
|
|
|
102
|
|
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=pod |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=item List(I) |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
my $gen = List( Bool, length=>[1,10] ); |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Creates a generator for lists (which are returned as array refs). The |
403
|
|
|
|
|
|
|
elements of the lists are generated by the generator given as |
404
|
|
|
|
|
|
|
I. The lengths of the generated lists are constrained by |
405
|
|
|
|
|
|
|
sizing guidance at the time of generation. You can override the |
406
|
|
|
|
|
|
|
default sizing behavior using the optional B modifier: |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
When the list generator calls the element generator, it divides the |
409
|
|
|
|
|
|
|
sizing guidance by the length of the list. For example, if the list |
410
|
|
|
|
|
|
|
being generated will have 7 elements, when the list generator calls |
411
|
|
|
|
|
|
|
the element generator to generate each element, it will scale the |
412
|
|
|
|
|
|
|
sizing guidance by 1/7. In this way the sizing guidance provides |
413
|
|
|
|
|
|
|
a rough constraint on the total number of elements produced, |
414
|
|
|
|
|
|
|
regardless of the depth of the list structure being generated. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=over 4 |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item List( ..., length=>I ) |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Generated lists are exactly length I. |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=item List( ..., length=>[I,] ) |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Generated lists are at least length I. (Maximum length is |
425
|
|
|
|
|
|
|
constrained by sizing factor.) |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=item List( ..., length=>[I,I] ) |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Generated lists are of length between I and I, inclusive. |
430
|
|
|
|
|
|
|
Sizing guidance is ignored. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=back |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
B If more than one I is given, they will be |
435
|
|
|
|
|
|
|
used in turn to create successive elements. In this case, the length |
436
|
|
|
|
|
|
|
of the list will be multiplied by the number of generators given. For |
437
|
|
|
|
|
|
|
example, providing two generators will create double-length lists. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=cut |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub List(@) { |
443
|
124
|
|
|
124
|
1
|
1082
|
my $template = _template(@_); |
444
|
|
|
|
|
|
|
my $builder = sub { |
445
|
480074
|
|
|
480074
|
|
549412
|
my ($len, $size) = @_; |
446
|
480074
|
100
|
|
|
|
914995
|
my $subsize = defined $size ? $size / ($len+1) : 1; |
447
|
480074
|
|
|
|
|
462529
|
my @list; |
448
|
480074
|
|
|
|
|
708706
|
foreach (1..$len) { |
449
|
2707381
|
|
|
|
|
3641730
|
foreach my $generator (@$template) { |
450
|
2709159
|
|
|
|
|
4366871
|
push @list, $generator->generate($subsize); |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
} |
453
|
480074
|
|
|
|
|
1844997
|
return \@list; |
454
|
124
|
|
|
|
|
517
|
}; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# return generator customized for length specification |
457
|
|
|
|
|
|
|
|
458
|
124
|
|
|
|
|
275
|
my $lenspec = _defargs("List", @_)->{length}; |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# case 0: length=>undef |
461
|
124
|
100
|
|
|
|
443
|
if ( ! defined $lenspec ) { |
462
|
6
|
|
|
|
|
16
|
$lenspec = [0,]; # convert into case 2 |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
# case 1: length=>N |
465
|
124
|
100
|
100
|
|
|
650
|
if ( ! ref($lenspec) ) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
466
|
80
|
|
|
|
|
104
|
my $n = $lenspec; |
467
|
80
|
100
|
|
|
|
364
|
croak "length=>$n can't be < 0" if $n < 0; |
468
|
|
|
|
|
|
|
return Gen { |
469
|
80065
|
|
|
80065
|
|
116336
|
return $builder->($lenspec, @_); |
470
|
|
|
|
|
|
|
} |
471
|
79
|
|
|
|
|
279
|
} |
472
|
|
|
|
|
|
|
# case 2: length=>[M,] |
473
|
|
|
|
|
|
|
elsif ( ref($lenspec) eq 'ARRAY' && @$lenspec == 1 ) { |
474
|
31
|
|
|
|
|
77
|
my ($m) = @$lenspec; |
475
|
31
|
100
|
|
|
|
166
|
croak "length=>[$m,] can't be < 0" if $m < 0; |
476
|
|
|
|
|
|
|
return Gen { |
477
|
320001
|
|
|
320001
|
|
347765
|
my ($size) = @_; |
478
|
320001
|
100
|
|
|
|
933059
|
return $builder->( $m >= $size |
479
|
|
|
|
|
|
|
? $m |
480
|
|
|
|
|
|
|
: $m + int(rand($size - $m + 1)), |
481
|
|
|
|
|
|
|
@_); |
482
|
30
|
|
|
|
|
153
|
}; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
# case 3: length=>[M,N] |
485
|
|
|
|
|
|
|
elsif ( ref($lenspec) eq 'ARRAY' && @$lenspec == 2 ) { |
486
|
10
|
|
|
|
|
24
|
my ($m,$n) = @$lenspec; |
487
|
10
|
100
|
100
|
|
|
230
|
croak "length=>[$m,$n]) is invalid" if $m > $n || $m < 0; |
488
|
|
|
|
|
|
|
return Gen { |
489
|
80008
|
|
|
80008
|
|
194525
|
return $builder->( $m + int(rand($n - $m + 1)), @_ ) |
490
|
8
|
|
|
|
|
44
|
}; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
# case 4: bad length specification |
493
|
|
|
|
|
|
|
else { |
494
|
3
|
|
|
|
|
304
|
croak "length specification length=>$lenspec is bad"; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=pod |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=item Hash(I, I) |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
my $gen = Hash( String( charset=>"A-Z", length=>3 ), |
503
|
|
|
|
|
|
|
Float( range=>[0.0, 100.0] ); |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
Creates a generator for hashes (which are returned as hash refs). The |
506
|
|
|
|
|
|
|
keys of the hash are generated by the generator given as I, |
507
|
|
|
|
|
|
|
and the values are generated by the generator I. |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
The Hash generator takes an optional B modifier that |
510
|
|
|
|
|
|
|
specifies the desired hash length (= number of keys): |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=over 4 |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=item Hash( ..., length=>I ) |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
Specifies the desired length of the generated hashes, using the same |
517
|
|
|
|
|
|
|
I syntax as for the List generator. Note that the |
518
|
|
|
|
|
|
|
generated hashes may be smaller than expected because of key |
519
|
|
|
|
|
|
|
collision. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=back |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=cut |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
sub Hash(@) { |
526
|
4
|
|
|
|
|
15
|
croak "Hash(keygen,valgen,...) requires two generators" |
527
|
4
|
100
|
|
4
|
1
|
5
|
unless @{_template(@_)} == 2; |
528
|
3
|
|
|
|
|
13
|
my $listgen = List(@_); |
529
|
|
|
|
|
|
|
return Gen { |
530
|
2
|
|
|
2
|
|
3
|
return { @{$listgen->generate(@_)} } |
|
2
|
|
|
|
|
8
|
|
531
|
3
|
|
|
|
|
16
|
}; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=pod |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=item String |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
my $gen = String( length=>[3,], charset=>"A-Z" ); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
Creates a generator for strings. By default the strings will |
541
|
|
|
|
|
|
|
be drawn from the ASCII character set (0 through 127) and |
542
|
|
|
|
|
|
|
be of length constrained by the sizing factor. Both defaults |
543
|
|
|
|
|
|
|
can be changed using modifiers: |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=over 4 |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=item String( charset=>I ) |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
Characters will be drawn from the character set given by the |
550
|
|
|
|
|
|
|
character-set specification I. The syntax of I is |
551
|
|
|
|
|
|
|
similar the Perl C |
operator and is a string comprised of
552
|
|
|
|
|
|
|
characters and character ranges. See Char for a full |
553
|
|
|
|
|
|
|
description. |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=item String( length=>I ) |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
Specifies the desired length of generated strings, using the same |
558
|
|
|
|
|
|
|
I syntax as for the List generator. |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=back |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=cut |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub String(@) { |
565
|
22
|
|
|
22
|
1
|
171339
|
my $args = _defargs("String", @_); |
566
|
22
|
|
|
|
|
75
|
my ($cset, $length) = @$args{qw(charset length)}; |
567
|
22
|
100
|
|
|
|
122
|
my $lcgen = List(Char(defined $cset ? (charset=>$cset) : ()), |
|
|
100
|
|
|
|
|
|
568
|
|
|
|
|
|
|
defined $length ? (length=>$length) : ()); |
569
|
|
|
|
|
|
|
return Gen { |
570
|
240004
|
|
|
240004
|
|
245889
|
join "", @{$lcgen->generate(@_)}; |
|
240004
|
|
|
|
|
405062
|
|
571
|
|
|
|
|
|
|
} |
572
|
22
|
|
|
|
|
849
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=pod |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=item Elements(I, I, ...) |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
my $gen = Elements( "alpha", "beta", "gamma" ); |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
Creates a generator that chooses among the given elements I, I, |
581
|
|
|
|
|
|
|
... with equal probability. Each call to the C method will |
582
|
|
|
|
|
|
|
return one of the element values. Sizing guidance has no effect on |
583
|
|
|
|
|
|
|
this generator. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
B This generator builder does not accept modifiers. If you |
586
|
|
|
|
|
|
|
pass any, they will be interpreted as elements to be added to the pool |
587
|
|
|
|
|
|
|
from which the generator randomly selects, which is probably not |
588
|
|
|
|
|
|
|
what you want. |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=cut |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub Elements(@) { |
593
|
38
|
100
|
|
38
|
1
|
24829
|
croak "Elements(e...) must be given at least one element" unless @_; |
594
|
37
|
|
|
|
|
80
|
return OneOf( map {Unit($_)} @_ ); |
|
2495
|
|
|
|
|
3746
|
|
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=pod |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=item Unit(I) |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
my $gen = Unit( "alpha" ); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
Creates a generator that always returns the value I. Not too |
604
|
|
|
|
|
|
|
useful on its own but can be handy as a building block for combinators |
605
|
|
|
|
|
|
|
to chew on. Naturally, sizing guidance has no effect on this |
606
|
|
|
|
|
|
|
generator. |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
B This generator builder does not accept modifiers. |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=cut |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
sub Unit($) { |
613
|
2732
|
|
|
2732
|
1
|
303835
|
my ($e) = @_; |
614
|
|
|
|
|
|
|
return Gen { |
615
|
2851402
|
|
|
2851402
|
|
8865983
|
return $e; |
616
|
|
|
|
|
|
|
} |
617
|
2732
|
|
|
|
|
7658
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=pod |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=back |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=head2 Generator combinators |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
The following combinators allow you to build more complicated |
632
|
|
|
|
|
|
|
generators from simpler ones. These combinators are exported into |
633
|
|
|
|
|
|
|
your code's namespace if you ask for C<:combinators> or C<:all> when |
634
|
|
|
|
|
|
|
you C |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=over 4 |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item Paste(I..., glue=>I) |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
my $gen = Paste( (String(charset=>"0-9",length=>4)) x 4, |
642
|
|
|
|
|
|
|
glue => " " ); |
643
|
|
|
|
|
|
|
# gens credit-card numbers like "4592 9459 9023 1369" |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
my $lgen = Paste( List( String(charset=>"0-9",length=>4) |
646
|
|
|
|
|
|
|
, length=>4 ), glue => " " ); |
647
|
|
|
|
|
|
|
# another way of doing the same |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Creates a combined generator that generates values by joining the |
650
|
|
|
|
|
|
|
values generated by each of the supplied sub-generators I. |
651
|
|
|
|
|
|
|
(Generated list values will have their elements "flattened" into the |
652
|
|
|
|
|
|
|
rest of the generated results before joining.) The resulting string is |
653
|
|
|
|
|
|
|
returned. |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
The values are joined using the given glue string I. If no |
656
|
|
|
|
|
|
|
B modifier is provided, the default glue is the empty string. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will |
659
|
|
|
|
|
|
|
be passed unchanged to each of the sub-generators. |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=cut |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub Paste(@) { |
664
|
7
|
|
|
7
|
1
|
574
|
my @gens = @{_template(@_)}; |
|
7
|
|
|
|
|
17
|
|
665
|
7
|
|
|
|
|
23
|
my $glue = _defargs("Paste", @_)->{glue}; |
666
|
7
|
|
|
6
|
|
43
|
Apply( sub { join $glue, map @$_, @_ }, Flatten(@gens) ); |
|
6
|
|
|
|
|
48
|
|
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
=pod |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=item OneOf(I...) |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
my $gen = OneOf( Unit(0), List(Int,length=>3) ); |
674
|
|
|
|
|
|
|
# generates scalar 0 or a 3-element list of integers |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Creates a combined generator that generates each value by selecting at |
677
|
|
|
|
|
|
|
random (with equal probability) one of the sub-generators in I |
678
|
|
|
|
|
|
|
and using that generator to generate the output value. |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
681
|
|
|
|
|
|
|
unchanged to the selected sub-generator. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=cut |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub OneOf(@) { |
689
|
38
|
|
|
38
|
1
|
121
|
my $gens = \@_; |
690
|
38
|
|
|
|
|
203
|
my $igen = Int(sized=>0,range=>[0, @_-1]); |
691
|
|
|
|
|
|
|
return Gen { |
692
|
1473673
|
|
|
1473673
|
|
2211617
|
return $gens->[$igen->generate]->generate(@_); |
693
|
|
|
|
|
|
|
} |
694
|
38
|
|
|
|
|
183
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=pod |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=item Frequency([I, I], [I, I], ...) |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
my $gen = Frequency( [50, Unit("common" )], |
701
|
|
|
|
|
|
|
[35, Unit("less common")], |
702
|
|
|
|
|
|
|
[15, Unit("uncommon" )] ); |
703
|
|
|
|
|
|
|
# generates one of "common", "less common", or |
704
|
|
|
|
|
|
|
# "uncommon" with respective probabilities |
705
|
|
|
|
|
|
|
# 50%, 35%, and 15%. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
Creates a combined generator that generates each value by selecting at |
708
|
|
|
|
|
|
|
random one of the generators I or I or ... and using that |
709
|
|
|
|
|
|
|
generator to generate the output value. Each generator is selected |
710
|
|
|
|
|
|
|
with probability proportional to its associated frequency. (If all of |
711
|
|
|
|
|
|
|
the given frequencies are the same, the Frequency combinator |
712
|
|
|
|
|
|
|
effectively becomes OneOf.) The frequencies can be any non-negative |
713
|
|
|
|
|
|
|
numerical values you want and will be normalized to a 0-to-1 scale |
714
|
|
|
|
|
|
|
internally. At least one frequency must be greater than zero. |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
717
|
|
|
|
|
|
|
unchanged to the selected sub-generator. |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=cut |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
sub Frequency(@) { |
724
|
8
|
|
|
8
|
1
|
2990
|
my @freqs = map {$_->[0]} @_; |
|
28
|
|
|
|
|
49
|
|
725
|
8
|
|
|
|
|
19
|
my @gens = map {$_->[1]} @_; |
|
28
|
|
|
|
|
80
|
|
726
|
8
|
100
|
|
|
|
24
|
if ((my @baddies = grep {$_ < 0} @freqs)) { |
|
28
|
|
|
|
|
71
|
|
727
|
1
|
|
|
|
|
142
|
croak "frequencies must be non-negative; got $baddies[0]"; |
728
|
|
|
|
|
|
|
} |
729
|
7
|
|
|
|
|
14
|
my $total = 0; |
730
|
7
|
|
|
|
|
31
|
$total += $_ foreach @freqs; |
731
|
7
|
100
|
|
|
|
27
|
unless ($total) { |
732
|
2
|
|
|
|
|
343
|
croak "at least one frequency must be greater than zero"; |
733
|
|
|
|
|
|
|
} |
734
|
5
|
|
|
|
|
12
|
@freqs = map {$_/$total} @freqs; # normalize to [0,1] scale |
|
25
|
|
|
|
|
50
|
|
735
|
5
|
|
|
|
|
9
|
$total = 0; |
736
|
5
|
|
|
|
|
25
|
$_ = $total += $_ for (@freqs); # turn into cumulative freqs |
737
|
5
|
|
|
|
|
9
|
$freqs[-1] = 1; # just in case of round-off error |
738
|
|
|
|
|
|
|
return Gen { |
739
|
22000
|
|
|
22000
|
|
22094
|
my $r = rand; |
740
|
22000
|
|
|
|
|
21254
|
my $i = 0; |
741
|
22000
|
|
|
|
|
105243
|
$i++ while $freqs[$i] < $r; |
742
|
22000
|
|
|
|
|
36489
|
return $gens[$i]->generate(@_); |
743
|
|
|
|
|
|
|
} |
744
|
5
|
|
|
|
|
24
|
} |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=pod |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=item Each(I...) |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
my $gen = Each( Unit(1), Unit("X") ); |
751
|
|
|
|
|
|
|
# always generates [ 1, "X" ] |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
Creates a generator that returns a list (array ref) whose |
754
|
|
|
|
|
|
|
successive elements are the successive values generated |
755
|
|
|
|
|
|
|
by the given generators I. |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
758
|
|
|
|
|
|
|
unchanged to each sub-generator. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
(Note for technical buffs: C is exactly equivalent to |
763
|
|
|
|
|
|
|
C1)>). |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=cut |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
sub Each(@) { |
768
|
55
|
|
|
55
|
1
|
652
|
return List( @_, length=>1 ); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=pod |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=item Apply(I, I...) |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
my $gen = Apply( sub { $_[0] x $_[1] } |
777
|
|
|
|
|
|
|
, Unit("X"), Unit(4) ); |
778
|
|
|
|
|
|
|
# always generates "XXXX" |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
Creates a generator that applies the given function I to arguments |
781
|
|
|
|
|
|
|
generated from each of the given sub-generators I and returns |
782
|
|
|
|
|
|
|
the resulting value. Each sub-generator contributes one value, and |
783
|
|
|
|
|
|
|
the values are passed to I as arguments in the same order as the |
784
|
|
|
|
|
|
|
sub-generators were given to Apply. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
787
|
|
|
|
|
|
|
unchanged to each sub-generator. |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
B The function I is always evaluated in scalar context. |
790
|
|
|
|
|
|
|
If you need to generate an array, return it as an array reference. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=cut |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
sub Apply(&@) { |
798
|
33
|
|
|
33
|
1
|
42
|
my $f = shift; |
799
|
33
|
|
|
|
|
89
|
my $g = Each( @_ ); |
800
|
|
|
|
|
|
|
return Gen { |
801
|
29
|
|
|
29
|
|
34
|
scalar $f->( @{$g->generate(@_)} ) |
|
29
|
|
|
|
|
58
|
|
802
|
33
|
|
|
|
|
121
|
}; |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=pod |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=item Map(I, I...) |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
my $gen = Map( sub { "X" x $_[0] } |
810
|
|
|
|
|
|
|
, Unit(4), Unit(3), Unit(0) ); |
811
|
|
|
|
|
|
|
# always generates [ "XXXX", "XXX", "" ] |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
Creates a generator that applies the given function I to the |
814
|
|
|
|
|
|
|
values generated by the given generators I one at a time and |
815
|
|
|
|
|
|
|
returns a list (array ref) whose elements are each of the successive |
816
|
|
|
|
|
|
|
results. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
819
|
|
|
|
|
|
|
unchanged to each sub-generator. |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
B The function I is always evaluated in scalar context. |
822
|
|
|
|
|
|
|
If you need to generate an array, return it as an array reference. |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=cut |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
sub _Map { |
829
|
18
|
|
|
18
|
|
25
|
my $f = shift; |
830
|
18
|
|
|
|
|
30
|
my $g = Each( @_ ); |
831
|
|
|
|
|
|
|
return Gen { |
832
|
15
|
|
|
15
|
|
13
|
[ map { scalar $f->($_) } @{ $g->generate(@_) } ] |
|
21
|
|
|
|
|
324
|
|
|
15
|
|
|
|
|
30
|
|
833
|
18
|
|
|
|
|
69
|
}; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
sub Map(&@) { |
837
|
2
|
|
|
2
|
1
|
577
|
_Map(@_); |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=pod |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=item Concat(I...) |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
my $gen = Concat( List( Unit(1), length=>3 ) |
845
|
|
|
|
|
|
|
, List( Unit("x"), length=>1 ) ); |
846
|
|
|
|
|
|
|
# always generates [1, 1, 1, "x"] |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
Creates a generator that concatenates the values generated by each of |
849
|
|
|
|
|
|
|
its sub-generators, resulting in a list (which is returned as a array |
850
|
|
|
|
|
|
|
reference). The values returned by the sub-generators are expected to |
851
|
|
|
|
|
|
|
be lists (array refs). If a sub-generator returns a scalar value, it |
852
|
|
|
|
|
|
|
will be treated like a single-element list that contains the value. |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
855
|
|
|
|
|
|
|
unchanged to each sub-generator. |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
B If a sub-generator returns something other than a list or |
858
|
|
|
|
|
|
|
scalar, you will get a run-time error. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=cut |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
# we'll use this helper in Flatten and ConcatMap (and Paste) |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
sub _concat(@) { |
867
|
76
|
100
|
|
76
|
|
305
|
[ map { ref($_) ? @{$_} : ($_) } @_ ]; |
|
100
|
|
|
|
|
328
|
|
|
54
|
|
|
|
|
766
|
|
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
sub Concat(@) { |
871
|
9
|
|
|
9
|
1
|
1256
|
Apply( \&_concat, @_ ); |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=pod |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=item Flatten(I...) |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
my $gen = Flatten( Unit( [[[[[[ 1 ]]]]]] ) ); |
880
|
|
|
|
|
|
|
# generates [1] |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
Flatten is just like Concat except that it recursively flattens any |
883
|
|
|
|
|
|
|
sublists generated by the generators I and then concatenates them |
884
|
|
|
|
|
|
|
to generate a final a list of depth one, regardless of the depth |
885
|
|
|
|
|
|
|
of any sublists. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
888
|
|
|
|
|
|
|
unchanged to each sub-generator. |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
B If a sub-generator returns something other than a list or |
891
|
|
|
|
|
|
|
scalar, you will get a run-time error. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=cut |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
sub _flatten(@); |
898
|
|
|
|
|
|
|
sub _flatten(@) { |
899
|
62
|
100
|
|
62
|
|
113
|
_concat map { ref($_) ? _flatten(@$_) : ($_) } @_ ; |
|
83
|
|
|
|
|
199
|
|
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
sub Flatten(@) { |
903
|
16
|
|
|
16
|
1
|
1221
|
Apply( \&_flatten, @_ ); |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=pod |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=item ConcatMap(I, I) |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
sub take_odds { my $x = shift; |
911
|
|
|
|
|
|
|
$x % 2 ? [$x] : [] } |
912
|
|
|
|
|
|
|
my $gen = ConcatMap( \&take_odds |
913
|
|
|
|
|
|
|
, Unit(1), Unit(2), Unit(3) ); |
914
|
|
|
|
|
|
|
# generates [1, 3] |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
Creates a generator that applies the function I to each of the |
917
|
|
|
|
|
|
|
values generated by the given generators I in turn, and then |
918
|
|
|
|
|
|
|
concatenates the results. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
921
|
|
|
|
|
|
|
unchanged to each sub-generator. |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
B The function I is always evaluated in scalar context. |
924
|
|
|
|
|
|
|
If you need to generate an array, return it as an array reference. |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
B If a sub-generator returns something other than a list or |
927
|
|
|
|
|
|
|
scalar, you will get a run-time error. |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=cut |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
sub ConcatMap(&@) { |
934
|
7
|
|
|
7
|
1
|
1048
|
my $g = _Map( @_ ); |
935
|
|
|
|
|
|
|
return Gen { |
936
|
6
|
|
|
6
|
|
11
|
_concat @{ $g->generate( @_ ) }; |
|
6
|
|
|
|
|
12
|
|
937
|
7
|
|
|
|
|
27
|
}; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=pod |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=item FlattenMap(I, I) |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
my $gen = FlattenMap( sub { [ ($_[0]) x 3 ] } |
946
|
|
|
|
|
|
|
, Unit([1]), Unit([[2]]) ); |
947
|
|
|
|
|
|
|
# generates [1, 1, 1, 2, 2, 2] |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
Creates a generator that applies the function I to each of the |
950
|
|
|
|
|
|
|
values generated by the given generators I in turn, and then |
951
|
|
|
|
|
|
|
flattens and concatenates the results. |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
The sizing guidance given to the combined generator will be passed |
954
|
|
|
|
|
|
|
unchanged to each sub-generator. |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
B The function I is always evaluated in scalar context. |
957
|
|
|
|
|
|
|
If you need to generate an array, return it as an array reference. |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
B If a sub-generator returns something other than a list or |
960
|
|
|
|
|
|
|
scalar, you will get a run-time error. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=cut |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
sub FlattenMap(&@) { |
967
|
9
|
|
|
9
|
1
|
1411
|
my $g = _Map( @_ ); |
968
|
|
|
|
|
|
|
return Gen { |
969
|
8
|
|
|
8
|
|
9
|
_flatten @{ $g->generate( @_ ) }; |
|
8
|
|
|
|
|
18
|
|
970
|
9
|
|
|
|
|
31
|
}; |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=pod |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=item Sized(I, I) |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
my $gen = Sized { 2 * $_[0] } List(Int); |
979
|
|
|
|
|
|
|
# ^ magnify sizing guidance by factor of two |
980
|
|
|
|
|
|
|
my $gen2 = Sized { 10 } Int; |
981
|
|
|
|
|
|
|
# ^ use constant guidance of 10 |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
Creates a generator that adjusts sizing guidance by passing it through |
984
|
|
|
|
|
|
|
the function I. Then it calls the generator I with the |
985
|
|
|
|
|
|
|
adjusted guidance and returns the result. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
B This combinator does not accept modifiers. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=cut |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
sub Sized(&$) { |
992
|
17
|
|
|
17
|
1
|
43
|
my ($sizer, $gen) = @_; |
993
|
|
|
|
|
|
|
return Gen { |
994
|
140400
|
|
|
140400
|
|
315374
|
return $gen->generate($sizer->(@_)); |
995
|
17
|
|
|
|
|
99
|
}; |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=pod |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=back |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=head2 Rolling your own generators |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
You can create your own generators by creating any object that |
1005
|
|
|
|
|
|
|
has a C method. Your method should accept as its |
1006
|
|
|
|
|
|
|
first argument sizing guidance I and, if it makes sense, |
1007
|
|
|
|
|
|
|
adjust the complexity of the values it generates accordingly. |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
The easiest way to create a generator is by using the magic function |
1010
|
|
|
|
|
|
|
C. It promotes a block of code into a generator. For example, |
1011
|
|
|
|
|
|
|
here's a home-brew generator for times in ctime(3) format that |
1012
|
|
|
|
|
|
|
is built on top of an Int generator: |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
use Test::LectroTest::Generator qw( :common Gen ); |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
my $time_gen = Int(range=>[0, 2_147_483_647], sized=>0); |
1017
|
|
|
|
|
|
|
my $ctime_gen = Gen { |
1018
|
|
|
|
|
|
|
scalar localtime $time_gen->generate( @_ ); |
1019
|
|
|
|
|
|
|
}; |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
print($ctime_gen->generate($_), "\n") for 1..5; |
1022
|
|
|
|
|
|
|
# Fri Jun 2 18:13:21 1978 |
1023
|
|
|
|
|
|
|
# Thu Mar 28 00:55:51 1974 |
1024
|
|
|
|
|
|
|
# Wed Mar 26 06:41:09 2025 |
1025
|
|
|
|
|
|
|
# Sun Sep 11 15:39:44 2016 |
1026
|
|
|
|
|
|
|
# Fri Dec 26 00:39:31 1975 |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Alternatively, we could build the generator using the Apply |
1029
|
|
|
|
|
|
|
combinator: |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
my $ctime_gen2 = Apply { localtime $_[0] } $time_gen; |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
B C is not exported into your code's namespace by default. |
1035
|
|
|
|
|
|
|
If you want to use it, you must import it by name or import C<:all> |
1036
|
|
|
|
|
|
|
when you use this module. |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=cut |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
1; |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
=head1 EXAMPLES |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
Here are some examples to consider. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=head2 Simple examples |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
use strict; |
1052
|
|
|
|
|
|
|
use Test::LectroTest::Generator qw(:common); |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
show("Ints (sized by default)", Int); |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
show("Floats (sized by default)", Float); |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
show("Percentages (unsized)", |
1059
|
|
|
|
|
|
|
Int( range=>[0,100], sized=>0 )); |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
show("Lists (sized by default) of Ints (unsized) in [0,10]", |
1062
|
|
|
|
|
|
|
List( Int( sized=>0, range=>[0,10] ) )); |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
show("Uppercase-alpha identifiers at least 3 chars long", |
1065
|
|
|
|
|
|
|
String( length=>[3,], charset=>"A-Z" )); |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
show("Hashes (sized by default) of form AAA=>Digit", |
1069
|
|
|
|
|
|
|
Hash( String( length=>3, charset=>"A-Z" ), |
1070
|
|
|
|
|
|
|
Int( sized=>0, range=>[0,9] ) )); |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
sub show { |
1073
|
|
|
|
|
|
|
print "\n", shift(), "\n"; |
1074
|
|
|
|
|
|
|
my ($gen) = @_; |
1075
|
|
|
|
|
|
|
for (1..10) { |
1076
|
|
|
|
|
|
|
my $val = $gen->generate($_); |
1077
|
|
|
|
|
|
|
printf "Size %2d: ", $_; |
1078
|
|
|
|
|
|
|
if (ref $val eq "HASH") { |
1079
|
|
|
|
|
|
|
my @pairs = map {"$_=>$val->{$_}"} keys %$val; |
1080
|
|
|
|
|
|
|
print "{ @pairs }"; |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
elsif (ref $val eq "ARRAY") { |
1083
|
|
|
|
|
|
|
print "[ @$val ]" |
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
else { |
1086
|
|
|
|
|
|
|
print $val; |
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
print "\n"; |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
} |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
=head2 Advanced examples |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
For these examples we use C to inspect the data |
1095
|
|
|
|
|
|
|
structures we generate. Also, we import not only the common generator |
1096
|
|
|
|
|
|
|
constructors (like Int) but also the generic Gen constructor, which |
1097
|
|
|
|
|
|
|
lets us build generators out of blocks on the fly. |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
use Data::Dumper; |
1100
|
|
|
|
|
|
|
use Test::LectroTest::Generator qw(:common Gen); |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
First, here's a recipe for building a list of lists of integers: |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
my $loloi_gen = List( List( Int(sized=>0) ) ); |
1105
|
|
|
|
|
|
|
print Dumper($loloi_gen->generate(10)); |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
You may want to run the example several times to get a feel |
1108
|
|
|
|
|
|
|
for the distribution of the generated output. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
Now, a more complicated example. Here we build sized trees of |
1111
|
|
|
|
|
|
|
random depth using a recursive set of generators. |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
my $tree_gen = do { |
1114
|
|
|
|
|
|
|
my $density = 0.5; |
1115
|
|
|
|
|
|
|
my $leaf_gen = Int( sized=>0 ); |
1116
|
|
|
|
|
|
|
my $tree_helper = \1; |
1117
|
|
|
|
|
|
|
my $branch_gen = List( Gen { $$tree_helper->generate(@_) } ); |
1118
|
|
|
|
|
|
|
$tree_helper = \Gen { |
1119
|
|
|
|
|
|
|
my ($size) = @_; |
1120
|
|
|
|
|
|
|
return rand($size) < $density |
1121
|
|
|
|
|
|
|
? $leaf_gen->generate($size) |
1122
|
|
|
|
|
|
|
: $branch_gen->generate($size + 1); |
1123
|
|
|
|
|
|
|
}; |
1124
|
|
|
|
|
|
|
$$tree_helper; |
1125
|
|
|
|
|
|
|
}; |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
print Dumper($tree_gen->generate(30)); |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
We define a tree as either a leaf or a branch, and we randomly decide |
1130
|
|
|
|
|
|
|
between the two at each node in the growing tree. Leaves are just |
1131
|
|
|
|
|
|
|
integers and become more likely when the sizing guidance diminishes |
1132
|
|
|
|
|
|
|
(which happens as we go deeper). The code uses C<$density> as a |
1133
|
|
|
|
|
|
|
control knob for leaf density. (Try re-running the above code after |
1134
|
|
|
|
|
|
|
changing the value of C<$density>. Try 0, 1, and 2.) Branches, |
1135
|
|
|
|
|
|
|
on the other hand, are lists of trees. Because branches generate |
1136
|
|
|
|
|
|
|
trees, and trees generate branches, we use a reference trick |
1137
|
|
|
|
|
|
|
to set up the mutually recursive relationship. This we encapsulate |
1138
|
|
|
|
|
|
|
within a B block for tidiness. |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
=head1 SEE ALSO |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
L gives a quick overview of automatic, |
1144
|
|
|
|
|
|
|
specification-based testing with LectroTest. |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=head1 AUTHOR |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
Tom Moertel (tom@moertel.com) |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
=head1 INSPIRATION |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
The LectroTest project was inspired by Haskell's |
1154
|
|
|
|
|
|
|
QuickCheck module by Koen Claessen and John Hughes: |
1155
|
|
|
|
|
|
|
http://www.cs.chalmers.se/~rjmh/QuickCheck/. |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
=head1 COPYRIGHT and LICENSE |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
Copyright (c) 2004-13 by Thomas G Moertel. All rights reserved. |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
1162
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
=cut |