File Coverage

blib/lib/Test/LectroTest/Generator.pm
Criterion Covered Total %
statement 189 189 100.0
branch 60 60 100.0
condition 15 15 100.0
subroutine 54 54 100.0
pod 20 23 86.9
total 338 341 99.1


built-in and is a string comprised of operator and is a string comprised of
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 this module.
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
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
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 this module.
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