Permalink
Browse files

Merge pull request #2 from maluco/master

Closure e teste.
  • Loading branch information...
2 parents 11d2860 + fab2fd4 commit 63509d2eabd99ecf606d2c375a10d3cd866d5a81 @garu committed Jun 20, 2011
Showing with 40 additions and 57 deletions.
  1. +11 −57 lib/Sub/Frequency.pm
  2. +29 −0 t/03-with_probability.t
View
@@ -25,63 +25,17 @@ my %probabilities = (
'Sub::Frequency::Never' => 0.00,
);
-sub always(&;@) {
- my ( $code, @rest ) = @_;
- my $name = 'Sub::Frequency::Always';
-
- if (wantarray) {
- return ( bless( $code, $name ), @rest );
- }
- else {
- _exec( $code, $name, @rest );
- }
-}
-
-sub normally(&;@) {
- my ( $code, @rest ) = @_;
- my $name = 'Sub::Frequency::Normally';
-
- if (wantarray) {
- return ( bless( $code, $name ), @rest );
- }
- else {
- _exec( $code, $name, @rest );
- }
-}
-
-sub sometimes(&;@) {
- my ( $code, @rest ) = @_;
- my $name = 'Sub::Frequency::Sometimes';
-
- if (wantarray) {
- return ( bless( $code, $name ), @rest );
- }
- else {
- _exec( $code, $name, @rest );
- }
-}
-
-sub rarely(&;@) {
- my ( $code, @rest ) = @_;
- my $name = 'Sub::Frequency::Rarely';
-
- if (wantarray) {
- return ( bless( $code, $name ), @rest );
- }
- else {
- _exec( $code, $name, @rest );
- }
-}
-
-sub never(&;@) {
- my ( $code, @rest ) = @_;
- my $name = 'Sub::Frequency::Never';
-
- if (wantarray) {
- return ( bless( $code, $name ), @rest );
- }
- else {
- _exec( $code, $name, @rest );
+foreach my $name (keys %probabilities) {
+ (my $subname = lc($name)) =~ s/.*:://g;
+ no strict 'refs';
+ *$subname = sub (&;@) {
+ my ( $code, @rest ) = @_;
+ if (wantarray) {
+ return ( bless( $code, $name ), @rest );
+ }
+ else {
+ _exec( $code, $name, @rest );
+ }
}
}
View
@@ -0,0 +1,29 @@
+
+use Test::More tests => 4;
+
+use Sub::Frequency;
+
+{
+ my $foo = 0;
+ always { $foo++ } for 1 .. 100;
+ is( $foo, 100, 'always' );
+}
+
+{
+ my $foo = 0;
+ ( with_probability 1 => sub { $foo++ } ) for 1 .. 100;
+ ok( $foo, 'with probability 100%' );
+}
+
+{
+ my $foo = 0;
+ never { $foo++ } for 1 .. 100;
+ is( $foo, 0, 'never');
+}
+
+{
+ my $foo = 0;
+ ( with_probability 0.50 => sub { $foo++ } ) for 1 .. 100;
+ ok( 1, 'with probablity 50%');
+}
+

0 comments on commit 63509d2

Please sign in to comment.