From 5a124d1485038dea17105e8a7d6a11fe350b7e4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Sun, 21 Jan 2018 22:08:59 +0000 Subject: [PATCH 1/3] Port tests to Test2 using Test2::Tools::Spec --- dist.ini | 1 + t/rand_chars.t | 329 ++++++++++++++++------------------------------ t/rand_date.t | 121 +++++++++-------- t/rand_datetime.t | 127 +++++++++--------- t/rand_enum.t | 103 ++++++++------- t/rand_image.t | 29 ++-- t/rand_set.t | 237 +++++++++++---------------------- t/rand_time.t | 144 +++++++++++--------- t/rand_words.t | 173 ++++++++++-------------- 9 files changed, 530 insertions(+), 734 deletions(-) diff --git a/dist.ini b/dist.ini index 9044a44..44cc754 100644 --- a/dist.ini +++ b/dist.ini @@ -42,3 +42,4 @@ GD = 0 Test::More = 0.88 File::Temp = 0 Test::MockTime = 0 +Test2::V0 = 0 diff --git a/t/rand_chars.t b/t/rand_chars.t index feb9619..961b629 100644 --- a/t/rand_chars.t +++ b/t/rand_chars.t @@ -1,257 +1,154 @@ -use strict; -use warnings; - -use Test::More; -use Data::Random qw( rand_chars ); - -use vars qw( %charsets ); - -%charsets = ( - all => [ - 0 .. 9, - 'a' .. 'z', - 'A' .. 'Z', - '#', - ',', - qw( ~ ! @ $ % ^ & * ( ) _ + = - { } | : " < > ? / . ' ; [ ] \ ` ) - ], - alpha => [ 'a' .. 'z', 'A' .. 'Z' ], - upperalpha => [ 'A' .. 'Z' ], - loweralpha => [ 'a' .. 'z' ], - numeric => [ 0 .. 9 ], - alphanumeric => [ 0 .. 9, 'a' .. 'z', 'A' .. 'Z' ], - misc => [ - '#', - ',', - qw( ~ ! @ $ % ^ & * ( ) _ + = - { } | : " < > ? / . ' ; [ ] \ ` ) - ], -); - -my %valid_chars; -my $string; - -foreach my $charset ( keys %charsets ) { - @{ $valid_chars{$charset} }{ @{ $charsets{$charset} } } = (); -} - -# Test default w/ no params -- should return one entry -{ - my $pass = 1; - - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; - - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_chars( set => $charsets{$charset} ); - - $pass = 0 - unless ( @chars == 1 - && exists( $valid_chars{$charset}->{ $chars[0] } ) ); - - $string = rand_chars( set => $charsets{$charset} ); - if (length($string) != 1 || !valid_chars($string, $charset)) { - $pass = 0; - } - - $i++; - } +use Test2::V0 -srand => 123456; - } +use Test2::Tools::Spec; - ok($pass); -} - -# Test size option -{ - my $pass = 1; +use Data::Random qw( rand_chars); - foreach my $charset ( keys %charsets ) { +describe 'Get random characters' => sub { + my (%charsets, $set); - my $num_chars = @{ $charsets{$charset} }; + before_all 'Prepare data' => sub { + %charsets = ( + loweralpha => [ 'a' .. 'z' ], + upperalpha => [ 'A' .. 'Z' ], + numeric => [ 0 .. 9 ], + misc => ['#', ',', qw# + ~ ! @ $ % ^ & * _ + = - | : " < > ? / . ' ; \ ` { } [ ] ( ) + #], + ); - my $i = 0; - while ( $pass && $i < $num_chars ) { - my $expected_length = $i + 1; - my @chars = rand_chars( set => $charsets{$charset}, - size => $expected_length); + $charsets{alpha} = + [ map { @{ $charsets{$_} } } qw( upperalpha loweralpha ) ]; - $pass = 0 unless @chars == $expected_length; + $charsets{alphanumeric} = + [ map { @{ $charsets{$_} } } qw( alpha numeric ) ]; - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); + $charsets{all} = [ + sort keys %{ + { map { $_ => 1 } map { @{$_} } values %charsets } } + ]; - $string = rand_chars( set => $charset, size => $expected_length ); - if ( length($string) != $expected_length - || !valid_chars($string, $charset)) - { - $pass = 0; - } + }; - $i++; - } + case 'alpha' => sub { $set = $charsets{alpha} }; + case 'numeric' => sub { $set = $charsets{numeric} }; + case 'misc' => sub { $set = $charsets{misc} }; + case 'upperlapha' => sub { $set = $charsets{upperalpha} }; + case 'lowerlapha' => sub { $set = $charsets{loweralpha} }; + case 'all' => sub { $set = $charsets{all} }; - } - - ok($pass); -} + describe 'Foo' => sub { + my ($valid, $num_chars, $result); -# Test max/min option -{ - my $pass = 1; + before_all 'Hash valid elements' => sub { + $valid = { map { $_ => 1 } @{$set} }; + $num_chars = scalar @{$set}; + }; - foreach my $charset ( keys %charsets ) { + around_each 'consolidate tests' => sub { + my $cont = shift; + $result = 1; + $cont->(); + ok $result; + }; - my $num_chars = @{ $charsets{$charset} }; + it 'Should return one character by default' => sub { + foreach (1 .. $num_chars) { + my @chars = rand_chars( set => $set ); - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_chars( - set => $charsets{$charset}, - min => $i, - max => $num_chars - ); + $result = quiet_is + scalar(@chars), 1, 'Got a single char'; - $pass = 0 unless ( @chars >= $i && @chars <= $num_chars ); + $result = quiet_like + $valid, { map { $_ => 1 } @chars }, 'Got a valid char'; - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); + last unless $result; } + }; - $string = rand_chars( set => $charsets{$charset}, - min => $i, - max => $num_chars - ); - if ( length($string) < $i - || length($string) > $num_chars - || !valid_chars($string, $charset)) - { - $pass = 0; - } - - $i++; - } + it 'Can specify return size' => sub { + foreach my $size (1 .. $num_chars) { + my @chars = rand_chars( set => $set, size => $size ); - } - - ok($pass); -} + $result = quiet_is + scalar(@chars), $size, 'Got right number of chars'; -# Test size w/ min/max set -{ - my $pass = 1; + $result = quiet_like + $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; - - my $i = 0; - while ( $pass && $i < $num_chars ) { - my $expected_length = $i + 1; - my @chars = rand_chars( - set => $charsets{$charset}, - size => $expected_length, - min => $i, - max => $num_chars - ); - - $pass = 0 unless @chars == $expected_length; - - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); + last unless $result; } + }; - $string = rand_chars( set => $charsets{$charset}, - size => $i + 1, - min => $i, - max => $num_chars - ); - if ( length($string) != $expected_length - || !valid_chars($string, $charset)) - { - $pass = 0; - } + it 'Can specify min and maximum for return list' => sub { + foreach my $size (1 .. $num_chars) { + my $min = $size - 1; + my @chars = rand_chars( + set => $set, + min => $min, + max => $num_chars, + ); - $i++; - } + $result = quiet_gte + scalar(@chars), $min, 'Got right number of chars'; - } + $result = quiet_like + $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; - ok($pass); -} - -# Test w/ shuffle set to 0 -{ - my $pass = 1; - - sub _get_index { - my ( $charset, $char ) = @_; + last unless $result; + } + }; - my $i = 0; - while ( $charsets{$charset}->[$i] ne $char - && $i < @{ $charsets{$charset} } ) - { - $i++; - } + it 'Ignores min and max if size is set' => sub { + foreach my $size (1 .. $num_chars) { + my @chars = rand_chars( + set => $set, + size => $size, + min => $size - 1, + max => $num_chars, + ); - $i; - } + $result = quiet_is + scalar(@chars), $size, 'Got right number of chars'; - foreach my $charset ( keys %charsets ) { + $result = quiet_like + $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; - my $num_chars = @{ $charsets{$charset} }; + last unless $result; + } + }; - my $i = 0; - while ( $pass && $i < $num_chars ) { - my $expected_length = 2; - my @chars = - rand_chars( set => $charsets{$charset}, - size => $expected_length, - shuffle => 0 ); + it 'Can keep order of chars' => sub { + foreach (1.. $num_chars) { + my @chars = rand_chars( + set => $set, + size => 2, + shuffle => 0, + ); - $pass = 0 - unless ( @chars == $expected_length - && _get_index( $charset, $chars[0] ) < - _get_index( $charset, $chars[1] ) ); + $result = quiet_is + scalar(@chars), 2, 'Got right number of chars'; - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); - } + $result = quiet_ok + _are_ordered( $set, @chars ), 'Characters are ordered'; - $string = rand_chars( set => $charsets{$charset}, - size => $expected_length, - shuffle => 0, - ); - if ( length($string) != $expected_length - || !valid_chars($string, $charset) - || ( _get_index($charset, substr($string, 0, 1)) - > _get_index($charset, substr($string, 1, 1)) - ) - ) - { - $pass = 0; + last unless $result; } + }; + }; +}; - $i++; - } - - } +done_testing; - ok($pass); +sub _are_ordered { + my ( $set, @chars ) = @_; + return _get_index($set, $chars[0]) < _get_index($set, $chars[1]); } -sub valid_chars -{ - my $string = shift; - my $charset = shift; - - foreach my $char (split('', $string)) { - return 0 if !exists($valid_chars{$charset}{$char}); - } - - return 1; +sub _get_index { + my ( $set, $char ) = @_; + my $i = 0; + $i++ while $set->[$i] ne $char && $i < @{ $set }; + $i; } - -done_testing; diff --git a/t/rand_date.t b/t/rand_date.t index 7638cd6..cc1c21a 100644 --- a/t/rand_date.t +++ b/t/rand_date.t @@ -1,75 +1,72 @@ -use strict; -use warnings; -use Test::More; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; use Data::Random qw( rand_date ); use Time::Piece; -my $today = localtime; +describe 'Time tests' => sub { + my ($min_date, $max_date, $case, $today); -my $min_date = Time::Piece->strptime($today->ymd, "%Y-%m-%d"); -my $max_date = $min_date->add_years(1); + before_all 'Get today' => sub { $today = localtime }; -my @tests = ( - { - name => 'no args', - args => {}, - min => $today->ymd, - max => $today->add_years(1)->ymd, - }, - { - name => 'min', - args => { - min => '1979-08-02', - }, - min => '1979-08-02', - max => '1980-08-02', - }, - { - name => 'min && max', - args => { - min => '2015-3-1', - max => '2015-5-10', - }, - min => '2015-03-01', - max => '2015-05-10', - }, - { - name => 'min now', - args => { - min => 'now', - }, - min => $today->ymd, - max => $today->add_years(1)->ymd, - }, - { - name => 'max now', - args => { - min => '2014-07-11', - max => 'now', - }, - min => '2014-07-11', - max => $today->ymd, - }, -); + before_each 'Create Time::Piece objects' => sub { + $min_date = Time::Piece->strptime( $case->{min}, '%Y-%m-%d' ); + $max_date = Time::Piece->strptime( $case->{max}, '%Y-%m-%d' ); + }; -for my $test (@tests) { - note "Running $test->{name}"; + case 'max now' => sub { + $case = { + args => { min => '2014-07-11', max => 'now' }, + min => '2014-07-11', + max => $today->ymd, + }; + }; - # creating Time::Piece objects from 'min' and 'max' values. - my $min_date = Time::Piece->strptime($test->{min},"%Y-%m-%d"); - my $max_date = Time::Piece->strptime($test->{max},"%Y-%m-%d"); + case 'min now' => sub { + $case = { + args => { min => 'now' }, + min => $today->ymd, + max => $today->add_years(1)->ymd, + }; + }; - for ( 0..999 ) { - my $rand_date = rand_date(%{$test->{args}}); - note "Result: $rand_date"; - like($rand_date, qr/^\d{4}-\d{2}-\d{2}$/, 'rand_date format'); + case 'min && max' => sub { + $case = { + args => { min => '2015-3-1', max => '2015-5-10' }, + min => '2015-03-01', + max => '2015-05-10', + }; + }; - my $result = Time::Piece->strptime($rand_date, "%Y-%m-%d"); - cmp_ok($result, '>=', $min_date, 'rand_date not smaller than minimum'); - cmp_ok($result, '<=', $max_date, 'rand_date not bigger than maximum'); - } -} + case 'min' => sub { + $case = { + args => { min => '1979-08-02' }, + min => '1979-08-02', + max => '1980-08-02', + }; + }; + + case 'no args' => sub { + $case = { + args => {}, + min => $today->ymd, + max => $today->add_years(1)->ymd, + }; + }; + + tests 'Random date is between boundaries' => sub { + for (0 .. 999) { + my $rand_date = rand_date( %{$case->{args}} ); + + like $rand_date, qr/^\d{4}-\d{2}-\d{2}$/, 'rand_date format'; + + my $result = Time::Piece->strptime( $rand_date, '%Y-%m-%d' ); + + cmp_ok $result, '>=', $min_date, 'rand_date >= minimum'; + cmp_ok $result, '<=', $max_date, 'rand_date <= maximum'; + } + }; +}; done_testing; diff --git a/t/rand_datetime.t b/t/rand_datetime.t index 6bead39..cb74e47 100644 --- a/t/rand_datetime.t +++ b/t/rand_datetime.t @@ -1,78 +1,75 @@ -use strict; -use warnings; -use Test::More; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; use Data::Random qw( rand_datetime ); use Time::Piece; -my $today = localtime; +describe 'Time tests' => sub { + my ($min_date, $max_date, $case, $today); -my $min_date = Time::Piece->strptime($today->ymd, "%Y-%m-%d"); -my $max_date = $min_date->add_years(1); + before_all 'Get today' => sub { $today = localtime }; -my @tests = ( - { - name => 'no args', - args => {}, - min => $today->ymd . ' ' . $today->hms, - max => $today->add_years(1)->ymd .' ' . $today->hms, - }, - { - name => 'min', - args => { - min => '1979-08-02 00:00:00', - }, - min => '1979-08-02 00:00:00', - max => '1980-08-02 23:59:59', - }, - { - name => 'min && max', - args => { - min => '2015-3-1 19:0:0', - max => '2015-5-10 8:00:00', - }, - min => '2015-03-01 19:00:00', - max => '2015-05-10 08:00:00', - }, - { - name => 'min now', - args => { - min => 'now', - }, - min => $today->ymd . ' ' . $today->hms, - max => $today->add_years(1)->ymd . ' ' . $today->hms, - }, - { - name => 'max now', - args => { - min => '2014-07-11 4:00:00', - max => 'now', - }, - min => '2014-07-11 4:00:00', - max => $today->ymd . ' ' . $today->hms, - }, -); + before_each 'Create Time::Piece objects' => sub { + $min_date = Time::Piece->strptime( $case->{min}, '%Y-%m-%d %H:%M:%S' ); + $max_date = Time::Piece->strptime( $case->{max}, '%Y-%m-%d %H:%M:%S' ); + }; -for my $test (@tests) { - note "Running $test->{name}"; + case 'max now' => sub { + $case = { + args => { min => '2014-07-11 4:00:00', max => 'now' }, + min => '2014-07-11 4:00:00', + max => $today->ymd . ' ' . $today->hms, + }; + }; - # creating Time::Piece objects from 'min' and 'max' values. - my $min_date = Time::Piece->strptime($test->{min},"%Y-%m-%d %H:%M:%S"); - my $max_date = Time::Piece->strptime($test->{max},"%Y-%m-%d %H:%M:%S"); + case 'min now' => sub { + $case = { + args => { min => 'now' }, + min => $today->ymd . ' ' . $today->hms, + max => $today->add_years(1)->ymd . ' ' . $today->hms, + }; + }; - for ( 0..999 ) { - my $rand_datetime = rand_datetime(%{$test->{args}}); - like( - $rand_datetime, - qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, - 'rand_datetime format' - ); + case 'min && max' => sub { + $case = { + args => { min => '2015-3-1 19:0:0', max => '2015-5-10 8:00:00' }, + min => '2015-03-01 19:00:00', + max => '2015-05-10 08:00:00', + }; + }; - my $result = Time::Piece->strptime($rand_datetime, "%Y-%m-%d %H:%M:%S"); - cmp_ok($result, '>=', $min_date, 'rand_datetime not smaller than minimum'); - cmp_ok($result, '<=', $max_date, 'rand_datetime not bigger than maximum'); - } -} + case 'min' => sub { + $case = { + args => { min => '1979-08-02 00:00:00' }, + min => '1979-08-02 00:00:00', + max => '1980-08-02 23:59:59', + }; + }; + + case 'no args' => sub { + $case = { + args => {}, + min => $today->ymd . ' ' . $today->hms, + max => $today->add_years(1)->ymd .' ' . $today->hms, + }; + }; + + tests 'Random date is between boundaries' => sub { + for (0 .. 999) { + my $rand_datetime = rand_datetime( %{$case->{args}} ); + + like $rand_datetime, + qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, + 'rand_datetime format'; + + my $result = Time::Piece + ->strptime( $rand_datetime, '%Y-%m-%d %H:%M:%S' ); + + cmp_ok $result, '>=', $min_date, 'rand_date >= minimum'; + cmp_ok $result, '<=', $max_date, 'rand_date <= maximum'; + } + }; +}; done_testing; diff --git a/t/rand_enum.t b/t/rand_enum.t index a3d91b7..16b0dfd 100644 --- a/t/rand_enum.t +++ b/t/rand_enum.t @@ -1,50 +1,63 @@ -use strict; -use warnings; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; -use Test::More; use Data::Random qw( rand_enum ); -my %charsets = ( - a => [], - b => ['A'], - c => [ 'A', 'B' ], - d => [ 'A' .. 'Z' ], -); - -my %valid_chars; - -foreach my $charset ( keys %charsets ) { - @{ $valid_chars{$charset} }{ @{ $charsets{$charset} } } = (); -} - -# Test default w/ no params -- should return one entry -{ - my $pass = 1; - - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; - - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_enum( set => $charsets{$charset} ); - - $pass = 0 - unless ( @chars == 1 - && exists( $valid_chars{$charset}->{ $chars[0] } ) ); - - $i++; - } - - } - - ok($pass); -} - -{ - my $char = rand_enum($charsets{d}); - ok $char, 'Can omit "set" if using an array ref'; - ok exists $valid_chars{d}->{ $char }, 'Got a valid random character'; -} +describe 'Single random element' => sub { + my ($set); + + case 'empty set' => sub { $set = [] }; + case 'single element' => sub { $set = ['A']; }; + case 'two elements' => sub { $set = ['A', 'B'] }; + case 'roman alphabet' => sub { $set = ['A' .. 'Z'] }; + + describe 'Get an element from a list' => sub { + my ($valid); + + before_all 'Hash valid elements' => sub { + $valid = { map { $_ => 1 } @{$set} }; + }; + + tests 'Random element is valid' => sub { + my $result = 1; + foreach (@{$set}) { + my @elems = rand_enum( set => $set ); + + unless (scalar(@elems) == 1) { + note 'Did not get a single element'; + $result = 0; + last; + } + + unless (exists $valid->{ $elems[0] }) { + note 'Did not get a valid element'; + $result = 0; + last; + } + } + ok $result; + }; + + tests 'Can omit "set" if using only an array ref' => sub { + my $result = 1; + if (@{$set}) { + my $char = rand_enum($set); + + unless ($char) { + note 'Did not return a character'; + $result = 0; + last; + } + + unless (exists $valid->{ $char }) { + note 'Did not return a valid character'; + $result = 0; + last; + } + } + ok $result; + }; + }; +}; done_testing; diff --git a/t/rand_image.t b/t/rand_image.t index f7eea39..2dd61f5 100644 --- a/t/rand_image.t +++ b/t/rand_image.t @@ -1,28 +1,21 @@ -use strict; -use warnings; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; -use Test::More; -use Data::Random qw( rand_image ); -use File::Temp; - -# Try to load GD eval q{ use GD }; +skip_all 'GD not installed' if $@; -SKIP: { - - # If the module cannot be loaded, skip tests - skip('GD not installed', 1) if $@; - - my ($fh, $imagefile) = File::Temp::tempfile(); +use Data::Random qw( rand_image ); +use File::Temp; - # Test writing an image to a file - { +describe 'Random image tests' => sub { + tests 'Create a random image' => sub { + my ($fh, $imagefile) = File::Temp::tempfile(); binmode($fh); print $fh rand_image( bgcolor => [ 0, 0, 0 ] ); close($fh); - ok( !( -z $imagefile ) ); - } -} + ok !( -z $imagefile ); + }; +}; done_testing; diff --git a/t/rand_set.t b/t/rand_set.t index 6f81bca..c5ee5ff 100644 --- a/t/rand_set.t +++ b/t/rand_set.t @@ -1,181 +1,98 @@ -use strict; -use warnings; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; +use Test2::Plugin::DieOnFail; -use Test::More; use Data::Random qw( rand_set ); -use vars qw( %charsets ); +describe 'Get random elements' => sub { + my ($set); -%charsets = ( - a => [], - b => ['A'], - c => [ 'A', 'B' ], - d => [ 'A' .. 'Z' ], -); + case 'empty set' => sub { $set = [] }; + case 'single element' => sub { $set = ['A']; }; + case 'two elements' => sub { $set = ['A', 'B'] }; + case 'roman alphabet' => sub { $set = ['A' .. 'Z'] }; -my %valid_chars; + describe 'Get elements from a list' => sub { + my ($valid); -foreach my $charset ( keys %charsets ) { - @{ $valid_chars{$charset} }{ @{ $charsets{$charset} } } = (); -} - -# Test default w/ no params -- should return one entry -{ - my $pass = 1; - - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; - - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_set( set => $charsets{$charset} ); - - $pass = 0 - unless ( @chars == 1 - && exists( $valid_chars{$charset}->{ $chars[0] } ) ); - - $i++; - } - - } - - ok($pass); -} - -# Test size option -{ - my $pass = 1; - - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; + before_all 'Hash valid elements' => sub { + $valid = { map { $_ => 1 } @{$set} }; + }; - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_set( set => $charsets{$charset}, size => $i + 1 ); - - $pass = 0 unless @chars == ( $i + 1 ); - - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); + it 'Defaults to returning a single element' => sub { + foreach (@{$set}) { + my @elems = rand_set( set => $set ); + is scalar(@elems), 1, 'Got a single element'; + ok exists $valid->{ $elems[0] }, 'Is a valid element'; } - - $i++; - } - - } - - ok($pass); -} - -# Test max/min option -{ - my $pass = 1; - - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; - - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_set( - set => $charsets{$charset}, - min => $i, - max => $num_chars - ); - - $pass = 0 unless ( @chars >= $i && @chars <= $num_chars ); - - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); + ok 1, 'pass'; + }; + + it 'Can return more elements with size parameter' => sub { + foreach my $size (1 .. scalar @{$set}) { + my @elems = rand_set( set => $set, size => $size ); + is scalar(@elems), $size, 'Got right number of elements'; + like $valid, { map { $_ => 1 } @elems }, 'All elements are valid'; } + ok 1, 'pass'; + }; + + it 'Can specify a minimum and a maximum for return size' => sub { + foreach my $size (1 .. scalar @{$set}) { + my $min = $size - 1; + my @elems = rand_set( + set => $set, + min => $min, + max => scalar(@{$set}), + ); - $i++; - } - - } - - ok($pass); -} - -# Test size w/ min/max set -{ - my $pass = 1; - - foreach my $charset ( keys %charsets ) { - - my $num_chars = @{ $charsets{$charset} }; - - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_set( - set => $charsets{$charset}, - size => $i + 1, - min => $i, - max => $num_chars - ); - - $pass = 0 unless @chars == ( $i + 1 ); - - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); + cmp_ok scalar(@elems), '>=', $min, + 'Got right number of elements'; + like $valid, { map { $_ => 1 } @elems }, 'All elements are valid'; } + ok 1, 'pass'; + }; + + it 'Ignores min and max if size is set' => sub { + foreach my $size (1 .. scalar @{$set}) { + my @elems = rand_set( + set => $set, + size => $size, + min => $size - 1, + max => scalar(@{$set}), + ); - $i++; - } - - } - - ok($pass); -} - -# Test w/ shuffle set to 0 -{ - my $pass = 1; - - sub _get_index { - my ( $charset, $char ) = @_; - - my $i = 0; - while ( $charsets{$charset}->[$i] ne $char - && $i < @{ $charsets{$charset} } ) - { - $i++; - } - - $i; - } - - foreach my $charset ( keys %charsets ) { + is scalar(@elems), $size, 'Got right number of elements'; + like $valid, { map { $_ => 1 } @elems }, 'All elements are valid'; + } + ok 1, 'pass'; + }; - my $num_chars = @{ $charsets{$charset} }; + it 'Can keep order of elements' => sub { + foreach (@{$set}) { + last unless scalar(@{$set}) >= 2; - if ( $num_chars >= 2 ) { - my $i = 0; - while ( $pass && $i < $num_chars ) { - my @chars = rand_set( - set => $charsets{$charset}, + my @elems = rand_set( + set => $set, size => 2, - shuffle => 0 + shuffle => 0, ); - $pass = 0 - unless ( @chars == 2 - && _get_index( $charset, $chars[0] ) < - _get_index( $charset, $chars[1] ) ); - - foreach (@chars) { - $pass = 0 unless exists( $valid_chars{$charset}->{$_} ); - } - - $i++; + is scalar(@elems), 2, 'Got right number of elements'; + cmp_ok + _get_index($set, $elems[0]), '<', + _get_index($set, $elems[1]), 'Elements are ordered'; } - } + ok 1, 'pass'; + }; + }; +}; - } +done_testing; - ok($pass); +sub _get_index { + my ( $set, $char ) = @_; + my $i = 0; + $i++ while $set->[$i] ne $char && $i < @{ $set }; + $i; } - -done_testing; diff --git a/t/rand_time.t b/t/rand_time.t index 9e0eb16..8f27f96 100644 --- a/t/rand_time.t +++ b/t/rand_time.t @@ -1,74 +1,92 @@ -use strict; -use warnings; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; -use Test::More; -use Test::MockTime qw( set_fixed_time ); use Data::Random qw( rand_time ); +use Test::MockTime qw( set_fixed_time ); +use Time::Piece; set_fixed_time('2018-01-21T18:54:00Z'); -# Test default w/ no params -test_range(); - -# Test min option -test_range('4:0:0'); - -# Test max option -test_range(undef, '4:0:0'); - -# Test min + max options -test_range('9:0:0', '10:0:0'); - -# Test min + max options using "now" -{ - my $time = rand_time( min => 'now', max => 'now' ); - my ( $hour, $min, $sec ) = ( localtime() )[ 2, 1, 0 ]; - - my ( $new_hour, $new_min, $new_sec ) = split ( /\:/, $time ); - - ok($new_hour == $hour && $new_min == $min && $new_sec == $sec, "random time constrained to a second works"); -} +describe 'Test time parameters' => sub { + my ($case); + + case 'No params' => sub { + $case = {}; + }; + + case 'With min' => sub { + $case = { min => '4:0:0' }; + }; + + case 'With max' => sub { + $case ={ max => '4:0:0' }; + }; + + case 'With min and max' => sub { + $case = { min => '9:0:0', max => '10:0:0' }; + }; + + describe 'For each case' => { flat => 1}, sub { + my ($min_secs, $max_secs, $iterations); + + before_all 'Determine test granularity' => sub { + $min_secs = defined $case->{min} + ? _to_secs($case->{min}) : 0; + + $max_secs = defined $case->{max} + ? _to_secs($case->{max}) : _to_secs('23:59:59'); + + # Running once for every possible value doesn't actually + # guarantee that we will _get_ every possible value, of course, + # since it's a randomly generated time. Running 10 times for + # every possible value pretty much guarantees that, but it also + # takes forever. So let's run 10x in the case of automated + # testers (like CPAN Testers), and just half that many otherwise + # (to keep installs speedy). + + $iterations = $max_secs - $min_secs + 1; + $iterations *= $ENV{AUTOMATED_TESTING} ? 10 : .5; + }; + + tests 'Random time is between boundaries' => sub { + my $errors = 0; + + for ( 1 .. $iterations ) { + my $time = rand_time( %{$case} ); + my $secs = _to_secs($time); + + my $error = 0; + $error = 1 unless defined($secs) + and ($secs >= $min_secs) + and ($secs <= $max_secs); + + if ($error) { + $errors += 1; + note 'Failed with ' . $time; + } + } + ok $errors == 0, 'foo'; + }; + }; +}; + +describe 'Test special parameters' => sub { + my ($case); + + case 'With min and max set to now' => sub { + $case = { min => 'now', max => 'now' }; + }; + + tests 'Random time is now' => sub { + my $time = rand_time( %{$case} ); + is [ map { s/^0//; $_ } split /:/, $time ], + [ ( localtime() )[ 2, 1, 0 ] ], + 'Random time constrained to a second works'; + }; +}; done_testing; - -sub test_range -{ - my ($min, $max) = @_; - my $min_secs = defined $min ? _to_secs($min) : 0; - my $max_secs = defined $max ? _to_secs($max) : _to_secs('23:59:59'); - - my @args; - push @args, min => $min if defined $min; - push @args, max => $max if defined $max; - - # Running once for every possible value doesn't actually guarantee that we will _get_ every - # possible value, of course, since it's a randomly generated time. Running 10 times for every - # possible value pretty much guarantees that, but it also takes forever. So let's run 10x in - # the case of automated testers (like CPAN Testers), and just half that many otherwise (to keep - # installs speedy). - my $num_tests = $max_secs - $min_secs + 1; - $num_tests *= $ENV{AUTOMATED_TESTING} ? 10 : .5; - - my $num_errors = 0; - my $test_name = "all randomly generated values within range"; - for ( 1..$num_tests ) - { - my $time = rand_time(@args); - my $secs = _to_secs($time); - - unless (defined $secs && $min_secs <= $secs && $secs <= $max_secs) - { - fail($test_name); - diag "time out of range: $time"; - ++$num_errors; - } - } - - pass($test_name) unless $num_errors; -} - - sub _to_secs { my $time = shift; diff --git a/t/rand_words.t b/t/rand_words.t index 73e030e..93f423f 100644 --- a/t/rand_words.t +++ b/t/rand_words.t @@ -1,120 +1,83 @@ -use strict; -use warnings; +use Test2::V0 -srand => 123456; +use Test2::Tools::Spec; +use Test2::Plugin::DieOnFail; -use Test::More; use Data::Random qw( rand_words ); use File::Temp; -use vars qw( $wordlist ); +describe 'Single random word' => sub { + my ($valid, $num_words, $wordlist); -my ($fh, $wordlist) = File::Temp::tempfile(); -foreach ( 'A' .. 'Z' ) { - print $fh "$_\n"; -} -close($fh); + before_all 'Prepare data' => sub { + my $fh; -my %valid_words; -@valid_words{ 'A' .. 'Z' } = (); + $num_words = 26; + ($fh, $wordlist) = File::Temp::tempfile(); -my $num_words = 26; - -# Test default w/ no params -- should return one entry -{ - my $pass = 1; - - my $i = 0; - while ( $pass && $i < $num_words ) { - my @words = rand_words( wordlist => $wordlist ); - - $pass = 0 unless ( @words == 1 && exists( $valid_words{ $words[0] } ) ); - - $i++; - } - - ok($pass); -} - -# Test size option -{ - my $pass = 1; - - my $i = 0; - while ( $pass && $i < $num_words ) { - my @words = rand_words( wordlist => $wordlist, size => $i + 1 ); - - $pass = 0 unless @words == ( $i + 1 ); - - foreach (@words) { - $pass = 0 unless exists( $valid_words{$_} ); + foreach ( 'A' .. 'Z' ) { + print $fh "$_\n"; + $valid->{$_} = 1; } - $i++; - } - - ok($pass); -} - -# Test max/min option -{ - my $pass = 1; + close($fh); + }; - my $i = 0; - while ( $pass && $i < $num_words ) { - my @words = - rand_words( wordlist => $wordlist, min => $i, max => $num_words ); - - $pass = 0 unless ( @words >= $i && @words <= $num_words ); - - foreach (@words) { - $pass = 0 unless exists( $valid_words{$_} ); + it 'Should return one word by default' => sub { + foreach (1 .. $num_words) { + my @words = rand_words( wordlist => $wordlist ); + is scalar(@words), 1, 'Got a single word'; + ok exists $valid->{ $words[0] }, 'Is a valid word'; } + }; - $i++; - } - - ok($pass); -} - -# Test size w/ min/max set -{ - my $pass = 1; - - my $i = 0; - while ( $pass && $i < $num_words ) { - my @words = rand_words( - wordlist => $wordlist, - size => $i + 1, - min => $i, - max => $num_words - ); - - $pass = 0 unless @words == ( $i + 1 ); - - foreach (@words) { - $pass = 0 unless exists( $valid_words{$_} ); + it 'Can specify return size' => sub { + foreach my $size (1 .. $num_words) { + my @words = rand_words( wordlist => $wordlist, size => $size ); + is scalar(@words), $size, 'Got right number of words'; + like $valid, { map { $_ => 1 } @words }, 'All words are valid'; } - - $i++; - } - - ok($pass); -} - -# Test w/ shuffle set to 0 -{ - my $pass = 1; - - my $i = 0; - while ( $pass && $i < $num_words ) { - my @words = - rand_words( wordlist => $wordlist, size => 2, shuffle => 0 ); - - $pass = 0 unless ( @words == 2 && !( $words[0] gt $words[1] ) ); - - $i++; - } - - ok($pass); -} + }; + + it 'Can specify min and maximum for return list' => sub { + foreach my $size (1 .. $num_words) { + my $min = $size - 1; + my @words = rand_words( + wordlist => $wordlist, + min => $min, + max => $num_words, + ); + + cmp_ok scalar(@words), '>=', $min, 'Got right number of words'; + like $valid, { map { $_ => 1 } @words }, 'All words are valid'; + } + }; + + it 'Ignores min and max if size is set' => sub { + foreach my $size (1 .. $num_words) { + my @words = rand_words( + wordlist => $wordlist, + size => $size, + min => $size - 1, + max => $num_words, + ); + + is scalar(@words), $size, 'Got right number of words'; + like $valid, { map { $_ => 1 } @words }, 'All words are valid'; + } + }; + + it 'Can keep order of words' => sub { + foreach (1.. $num_words) { + my @words = rand_words( + wordlist => $wordlist, + size => 2, + shuffle => 0, + ); + + is scalar(@words), 2, 'Got right number of words'; + cmp_ok $words[0], 'lt', $words[1], 'Words are ordered'; + } + }; +}; done_testing; From d225f91c4fe753428cfc0a71ff7823d42c11bfa8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Thu, 4 Oct 2018 22:25:43 +0100 Subject: [PATCH 2/3] Return array reference instead of array of references --- lib/Data/Random.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Data/Random.pm b/lib/Data/Random.pm index 2c21552..fae6a7a 100755 --- a/lib/Data/Random.pm +++ b/lib/Data/Random.pm @@ -234,7 +234,7 @@ sub rand_set { return @{ $options{'set'} }[@results]; } else { - return \@{ $options{'set'} }[@results]; + return [ @{ $options{'set'} }[@results] ]; } } From b792e829a791c3a97fdafef50c12ea8a1f2a2ab3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Joaqu=C3=ADn=20Atria?= Date: Sun, 21 Jan 2018 22:08:59 +0000 Subject: [PATCH 3/3] Make tests run faster and cover more code --- lib/Data/Random.pm | 4 +- t/rand_chars.t | 192 +++++++++++++++++++++++++-------------------- t/rand_date.t | 44 +++++++---- t/rand_datetime.t | 61 +++++++++----- t/rand_enum.t | 77 +++++++++--------- t/rand_image.t | 154 +++++++++++++++++++++++++++++++++--- t/rand_set.t | 16 ++++ t/rand_time.t | 131 ++++++++++++++----------------- t/rand_words.t | 35 ++++++++- 9 files changed, 471 insertions(+), 243 deletions(-) diff --git a/lib/Data/Random.pm b/lib/Data/Random.pm index fae6a7a..3f62c31 100755 --- a/lib/Data/Random.pm +++ b/lib/Data/Random.pm @@ -776,11 +776,11 @@ height - the height of the image. If you supply a value for 'width', then 'minw =item * -minpixels - the minimum number of random pixels to display on the image. The default is 0. +minpixels - the minimum number of random pixels to display on the image. The default is 0. Note that this does not control the minimum number of pixels I, since this is determined by the image's dimensions. =item * -maxpixels - the maximum number of random pixels to display on the image. The default is width * height. +maxpixels - the maximum number of random pixels to display on the image. The default is width * height. Note that this is not control the number of pixels I, since this is determined by the image's dimensions. =item * diff --git a/t/rand_chars.t b/t/rand_chars.t index 961b629..a3aeb96 100644 --- a/t/rand_chars.t +++ b/t/rand_chars.t @@ -1,11 +1,32 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; use Test2::Tools::Spec; use Data::Random qw( rand_chars); +describe 'Context sensitivity' => sub { + my %args = ( set => [ 'A' .. 'Z' ], size => 5 ); + + before_each 'Seed' => sub { srand(123456); }; + + it 'Returns an array in list context' => sub { + is [ rand_chars( %args ) ], [qw( R Y Q B F )]; + }; + + it 'Returns a concatenated string in scalar context' => sub { + is +rand_chars( %args ), 'RYQBF'; + }; +}; + +describe 'Bad input' => sub { + it 'Assumes an empty set if it is unknown' => sub { + my @ret = rand_chars( set => 'some name', min => 0 ); + is \@ret, []; + }; +}; + describe 'Get random characters' => sub { - my (%charsets, $set); + my (%charsets, $set, $size, $seed); before_all 'Prepare data' => sub { %charsets = ( @@ -17,124 +38,127 @@ describe 'Get random characters' => sub { #], ); + $charsets{all} = [ sort map { @{$_} } values %charsets ]; + + $charsets{char} = $charsets{misc}; + $charsets{alpha} = [ map { @{ $charsets{$_} } } qw( upperalpha loweralpha ) ]; $charsets{alphanumeric} = [ map { @{ $charsets{$_} } } qw( alpha numeric ) ]; - $charsets{all} = [ - sort keys %{ - { map { $_ => 1 } map { @{$_} } values %charsets } - } - ]; + $size = 3; + $seed = 666; + }; + before_each 'Random seed' => sub { + srand($seed); }; - case 'alpha' => sub { $set = $charsets{alpha} }; - case 'numeric' => sub { $set = $charsets{numeric} }; - case 'misc' => sub { $set = $charsets{misc} }; - case 'upperlapha' => sub { $set = $charsets{upperalpha} }; - case 'lowerlapha' => sub { $set = $charsets{loweralpha} }; - case 'all' => sub { $set = $charsets{all} }; + describe 'Explicit sets' => sub { - describe 'Foo' => sub { - my ($valid, $num_chars, $result); + case 'alpha' => sub { $set = $charsets{alpha} }; + case 'numeric' => sub { $set = $charsets{numeric} }; + case 'misc' => sub { $set = $charsets{misc} }; + case 'upperlapha' => sub { $set = $charsets{upperalpha} }; + case 'lowerlapha' => sub { $set = $charsets{loweralpha} }; + case 'all' => sub { $set = $charsets{all} }; - before_all 'Hash valid elements' => sub { - $valid = { map { $_ => 1 } @{$set} }; - $num_chars = scalar @{$set}; - }; + describe 'Foo' => sub { + my ($valid, $num_chars, $result); - around_each 'consolidate tests' => sub { - my $cont = shift; - $result = 1; - $cont->(); - ok $result; - }; + before_all 'Hash valid elements' => sub { + $valid = { map { $_ => 1 } @{$set} }; + $num_chars = scalar @{$set}; + }; - it 'Should return one character by default' => sub { - foreach (1 .. $num_chars) { + it 'Returns one character by default' => sub { my @chars = rand_chars( set => $set ); + is scalar(@chars), 1, 'Got a single char'; + like $valid, { map { $_ => 1 } @chars }, 'Got a valid char'; + }; - $result = quiet_is - scalar(@chars), 1, 'Got a single char'; - - $result = quiet_like - $valid, { map { $_ => 1 } @chars }, 'Got a valid char'; - - last unless $result; - } - }; - - it 'Can specify return size' => sub { - foreach my $size (1 .. $num_chars) { + it 'Can specify return size' => sub { my @chars = rand_chars( set => $set, size => $size ); + is scalar(@chars), $size, 'Got right number of chars'; + like $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; + }; - $result = quiet_is - scalar(@chars), $size, 'Got right number of chars'; + it 'Can specify min and maximum for return list' => sub { + my $max = int( scalar(@{$set}) / 2 ) + 1; + my @baseline; - $result = quiet_like - $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; + do { + $max--; + srand($seed); + @baseline = rand_chars( set => $set, max => $max ); + } until $max < 1 or scalar(@baseline) < $max; - last unless $result; - } - }; + if ($max < 1) { + ok 1, 'Abandoned test, because of bad seed'; + return; + }; - it 'Can specify min and maximum for return list' => sub { - foreach my $size (1 .. $num_chars) { - my $min = $size - 1; - my @chars = rand_chars( - set => $set, - min => $min, - max => $num_chars, - ); + note 'Got ' . scalar @baseline . ' elements without min'; - $result = quiet_gte - scalar(@chars), $min, 'Got right number of chars'; + srand($seed); + my $min = scalar(@baseline) + 1; + my @chars = rand_chars( set => $set, min => $min, max => $max ); - $result = quiet_like - $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; + note 'Got ' . scalar @chars . ' elements with min'; - last unless $result; - } - }; + cmp_ok scalar(@chars), '>=', $min, 'Min affected rand_chars outcome'; + like $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; + }; - it 'Ignores min and max if size is set' => sub { - foreach my $size (1 .. $num_chars) { + it 'Ignores min and max if size is set' => sub { my @chars = rand_chars( - set => $set, - size => $size, - min => $size - 1, - max => $num_chars, + set => $set, + size => $size * 2, + max => $size, ); - $result = quiet_is - scalar(@chars), $size, 'Got right number of chars'; + is scalar(@chars), $size * 2, 'Ignored max'; + like $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; - $result = quiet_like - $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; + @chars = rand_chars( + set => $set, + size => $size, + min => $size * 2, + ); - last unless $result; - } - }; + is scalar(@chars), $size, 'Ignored min'; + like $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; + }; - it 'Can keep order of chars' => sub { - foreach (1.. $num_chars) { + it 'Can keep order of chars' => sub { my @chars = rand_chars( - set => $set, + set => $set, size => 2, shuffle => 0, ); - $result = quiet_is - scalar(@chars), 2, 'Got right number of chars'; - - $result = quiet_ok - _are_ordered( $set, @chars ), 'Characters are ordered'; + is scalar(@chars), 2, 'Got right number of chars'; + ok _are_ordered( $set, @chars ), 'Characters are ordered'; + }; + }; + }; - last unless $result; - } + describe 'Sets by name' => sub { + case 'alpha' => sub { $set = 'alpha' }; + case 'numeric' => sub { $set = 'numeric' }; + case 'alphanumeric' => sub { $set = 'alphanumeric' }; + case 'misc' => sub { $set = 'misc' }; + case 'char' => sub { $set = 'char' }; + case 'upperlapha' => sub { $set = 'upperalpha' }; + case 'lowerlapha' => sub { $set = 'loweralpha' }; + case 'all' => sub { $set = 'all' }; + + it 'Gets characters from the correct set' => sub { + my $valid = { map { $_ => 1 } @{$charsets{$set}} }; + my @chars = rand_chars( set => $set, size => 10 ); + like $valid, { map { $_ => 1 } @chars }, 'All characters are valid'; }; }; }; diff --git a/t/rand_date.t b/t/rand_date.t index cc1c21a..ac9e90c 100644 --- a/t/rand_date.t +++ b/t/rand_date.t @@ -1,28 +1,45 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; use Test2::Tools::Spec; +BEGIN { use Test::MockTime qw( set_fixed_time ); } + use Data::Random qw( rand_date ); use Time::Piece; -describe 'Time tests' => sub { - my ($min_date, $max_date, $case, $today); +describe 'Bad input' => sub { + it 'Warns if min date is later than max date' => sub { + like warning + { rand_date( max => '2010-01-01', min => '2020-01-01' ) }, + qr/later than/; + }; +}; - before_all 'Get today' => sub { $today = localtime }; +describe 'Time boundaries' => sub { + my ($min_date, $max_date, $case); + + before_case 'Set fixed time' => sub { + set_fixed_time('1987-12-18T00:00:00Z'); + }; before_each 'Create Time::Piece objects' => sub { $min_date = Time::Piece->strptime( $case->{min}, '%Y-%m-%d' ); $max_date = Time::Piece->strptime( $case->{max}, '%Y-%m-%d' ); + + srand(12345); # Generates 2018-04-27 }; case 'max now' => sub { + my $today = localtime; $case = { - args => { min => '2014-07-11', max => 'now' }, - min => '2014-07-11', + args => { min => '1986-12-18', max => 'now' }, + min => $today->add_years(-1)->ymd, max => $today->ymd, }; }; case 'min now' => sub { + set_fixed_time('2020-12-18T00:00:00Z'); + my $today = localtime; $case = { args => { min => 'now' }, min => $today->ymd, @@ -47,6 +64,7 @@ describe 'Time tests' => sub { }; case 'no args' => sub { + my $today = localtime; $case = { args => {}, min => $today->ymd, @@ -55,18 +73,16 @@ describe 'Time tests' => sub { }; tests 'Random date is between boundaries' => sub { - for (0 .. 999) { - my $rand_date = rand_date( %{$case->{args}} ); + my $rand_date = rand_date( %{$case->{args}} ); - like $rand_date, qr/^\d{4}-\d{2}-\d{2}$/, 'rand_date format'; + like $rand_date, qr/^\d{4}-\d{2}-\d{2}$/, 'rand_date format'; - my $result = Time::Piece->strptime( $rand_date, '%Y-%m-%d' ); + my $result = Time::Piece->strptime( $rand_date, '%Y-%m-%d' ); - cmp_ok $result, '>=', $min_date, 'rand_date >= minimum'; - cmp_ok $result, '<=', $max_date, 'rand_date <= maximum'; - } + note $rand_date; + cmp_ok $result, '>=', $min_date, 'rand_date >= minimum'; + cmp_ok $result, '<=', $max_date, 'rand_date <= maximum'; }; }; done_testing; - diff --git a/t/rand_datetime.t b/t/rand_datetime.t index cb74e47..5be397d 100644 --- a/t/rand_datetime.t +++ b/t/rand_datetime.t @@ -1,28 +1,45 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; use Test2::Tools::Spec; +BEGIN { use Test::MockTime qw( set_fixed_time ); } + use Data::Random qw( rand_datetime ); use Time::Piece; -describe 'Time tests' => sub { - my ($min_date, $max_date, $case, $today); +describe 'Bad input' => sub { + it 'Warns if min date is later than max date' => sub { + like warning + { rand_datetime( max => '2010-01-01', min => '2020-01-01' ) }, + qr/later than/; + }; +}; - before_all 'Get today' => sub { $today = localtime }; +describe 'Time boundaries' => sub { + my ($min_date, $max_date, $case); + + before_case 'Set fixed time' => sub { + set_fixed_time('1987-12-18T00:00:00Z'); + }; before_each 'Create Time::Piece objects' => sub { $min_date = Time::Piece->strptime( $case->{min}, '%Y-%m-%d %H:%M:%S' ); $max_date = Time::Piece->strptime( $case->{max}, '%Y-%m-%d %H:%M:%S' ); + + srand(12345); # Generates 2018-04-28 00:11:39 }; case 'max now' => sub { + my $today = localtime; $case = { - args => { min => '2014-07-11 4:00:00', max => 'now' }, - min => '2014-07-11 4:00:00', + args => { min => '1984-07-11 4:00:00', max => 'now' }, + min => '1984-07-11 4:00:00', max => $today->ymd . ' ' . $today->hms, }; }; case 'min now' => sub { + set_fixed_time('2020-12-18T00:00:00Z'); + my $today = localtime; $case = { args => { min => 'now' }, min => $today->ymd . ' ' . $today->hms, @@ -31,10 +48,14 @@ describe 'Time tests' => sub { }; case 'min && max' => sub { + set_fixed_time('2001-12-18T00:00:00Z'); + my $today = localtime; + my $min = $today->ymd . ' ' . $today->hms; + my $max = $today->add_years(1)->ymd . ' ' . $today->hms; $case = { - args => { min => '2015-3-1 19:0:0', max => '2015-5-10 8:00:00' }, - min => '2015-03-01 19:00:00', - max => '2015-05-10 08:00:00', + args => { min => $min, max => $max }, + min => $min, + max => $max, }; }; @@ -47,6 +68,7 @@ describe 'Time tests' => sub { }; case 'no args' => sub { + my $today = localtime; $case = { args => {}, min => $today->ymd . ' ' . $today->hms, @@ -55,21 +77,20 @@ describe 'Time tests' => sub { }; tests 'Random date is between boundaries' => sub { - for (0 .. 999) { - my $rand_datetime = rand_datetime( %{$case->{args}} ); + my $rand_datetime = rand_datetime( %{$case->{args}} ); - like $rand_datetime, - qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, - 'rand_datetime format'; + like $rand_datetime, + qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, + 'rand_datetime format'; - my $result = Time::Piece - ->strptime( $rand_datetime, '%Y-%m-%d %H:%M:%S' ); + my $result = Time::Piece + ->strptime( $rand_datetime, '%Y-%m-%d %H:%M:%S' ); - cmp_ok $result, '>=', $min_date, 'rand_date >= minimum'; - cmp_ok $result, '<=', $max_date, 'rand_date <= maximum'; - } + note $rand_datetime; + cmp_ok $rand_datetime, 'ne', '2018-04-28 00:11:39', 'Date was changed'; + cmp_ok $result, '>=', $min_date, "$rand_datetime >= $case->{min}"; + cmp_ok $result, '<=', $max_date, "$rand_datetime <= $case->{max}"; }; }; done_testing; - diff --git a/t/rand_enum.t b/t/rand_enum.t index 16b0dfd..d7cba6b 100644 --- a/t/rand_enum.t +++ b/t/rand_enum.t @@ -1,4 +1,4 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; use Test2::Tools::Spec; use Data::Random qw( rand_enum ); @@ -6,7 +6,6 @@ use Data::Random qw( rand_enum ); describe 'Single random element' => sub { my ($set); - case 'empty set' => sub { $set = [] }; case 'single element' => sub { $set = ['A']; }; case 'two elements' => sub { $set = ['A', 'B'] }; case 'roman alphabet' => sub { $set = ['A' .. 'Z'] }; @@ -18,46 +17,48 @@ describe 'Single random element' => sub { $valid = { map { $_ => 1 } @{$set} }; }; - tests 'Random element is valid' => sub { - my $result = 1; - foreach (@{$set}) { - my @elems = rand_enum( set => $set ); - - unless (scalar(@elems) == 1) { - note 'Did not get a single element'; - $result = 0; - last; - } - - unless (exists $valid->{ $elems[0] }) { - note 'Did not get a valid element'; - $result = 0; - last; - } - } - ok $result; + it 'Returns a single valid element' => sub { + my @elems = rand_enum( set => $set ); + is scalar(@elems), 1, 'Got a single element'; + like $valid, { map { $_ => 1 } @elems }, 'Got a valid element'; }; - tests 'Can omit "set" if using only an array ref' => sub { - my $result = 1; - if (@{$set}) { - my $char = rand_enum($set); - - unless ($char) { - note 'Did not return a character'; - $result = 0; - last; - } - - unless (exists $valid->{ $char }) { - note 'Did not return a valid character'; - $result = 0; - last; - } - } - ok $result; + it 'Assumes set when only argument is an array ref' => sub { + my @elems = rand_enum( $set ); + is scalar(@elems), 1, 'Got a single element'; + like $valid, { map { $_ => 1 } @elems }, 'Got a valid element'; }; }; }; +describe 'Edge cases' => sub { + my $elem; + + it 'Returns undef with an empty set' => sub { + is rand_enum( set => [] ), U(); + }; + + it 'Dies if set is not an array reference' => sub { + like dies { rand_enum( set => {} ) }, qr/Not an ARRAY reference/; + }; + + it 'Requires a set' => sub { + like warning { $elem = rand_enum() }, qr/set array is not defined/; + is $elem, U(), 'Returns undefined'; + }; + + it 'Only assumes set when given a single argument array reference' => sub { + like warning { $elem = rand_enum( [], 'foo' ) }, + qr/set array is not defined/; + is $elem, U(), 'Returns undefined'; + + like warnings { $elem = rand_enum( {} ) }, + [ + qr/even-sized list expected/, + qr/set array is not defined/, + ]; + is $elem, U(), 'Returns undefined'; + }; +}; + done_testing; diff --git a/t/rand_image.t b/t/rand_image.t index 2dd61f5..f0257d9 100644 --- a/t/rand_image.t +++ b/t/rand_image.t @@ -1,20 +1,152 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; +use Test2::Require::Module 'GD'; use Test2::Tools::Spec; -eval q{ use GD }; -skip_all 'GD not installed' if $@; - use Data::Random qw( rand_image ); -use File::Temp; +use File::Temp qw( tempfile ); describe 'Random image tests' => sub { - tests 'Create a random image' => sub { - my ($fh, $imagefile) = File::Temp::tempfile(); - binmode($fh); - print $fh rand_image( bgcolor => [ 0, 0, 0 ] ); - close($fh); + my ($fh, $filename, %args, %check, $image); + + before_each 'Create file' => sub { + ($fh, $filename) = tempfile( UNLINK => 0 ); + srand( 123456 ); # Produces a 95 x 68 pixel image + }; + + around_each 'Open and close' => sub { + binmode $fh; + print $fh rand_image( %args ) and close $fh; + ok $image = GD::Image->new( $filename ), 'Can read image file'; + shift->(); + }; + + after_each 'Remove file' => sub { + unlink $filename; + }; + + describe 'Dimension controls' => sub { + case 'No arguments' => sub { + %check = %args = (); + }; + + case 'Specific width' => sub { + %check = %args = ( width => 33 ); + $check{height} = 95; + }; + + case 'Specific height' => sub { + %check = %args = ( height => 33 ); + }; + + case 'Minimum width' => sub { + %args = ( minwidth => 80 ); + %check = ( width => 99 ); + }; + + case 'Maximum width' => sub { + %args = ( maxwidth => 60 ); + %check = ( width => 57 ); + }; + + case 'Maximum height' => sub { + %args = ( maxheight => 50 ); + %check = ( height => 34 ); + }; + + case 'Minimum height' => sub { + %args = ( minheight => 80 ); + %check = ( height => 94 ); + }; + + it 'Controls the size of the image' => sub { + note 'H' . $image->height . ' x W' . $image->width; + + is $image->height, $check{height} // 68, 'Correct height'; + is $image->width, $check{width} // 95, 'Correct width'; + }; + }; + + describe 'Color options' => sub { + case 'No arguments' => sub { + %check = %args = (); + }; + + case 'Background' => sub { + %check = %args = ( bgcolor => [ 1, 2, 3 ] ); + }; + + case 'Foreground' => sub { + %check = %args = ( fgcolor => [ 3, 2, 1 ] ); + }; + + case 'Both' => sub { + %check = %args = ( bgcolor => [ 3, 2, 1], fgcolor => [ 1, 2, 3 ] ); + }; + + it 'Sets the colors in the image' => sub { + is [ $image->rgb(0) ], $check{bgcolor}, + 'Correct background color' if $args{bgcolor}; + + is [ $image->rgb(1) ], $check{fgcolor}, + 'Correct foreground color' if $args{fgcolor}; + + is $image->trueColor, F(), 'Image is palette based'; + is $image->colorsTotal, 2, 'Has foreground and background colors'; + }; + }; + +}; + +describe 'Pixel options' => sub { + my (%args, %check, $img, $pixels, $override); + + before_all 'Mock' => sub { + $override = mock 'GD::Image', override => [ + png => sub ($;$) { $img = shift }, + setPixel => sub ($$$$) { $pixels++ }, + ]; + }; + + before_each 'Reset' => sub { + $pixels = 0; + srand(9); # Produces a 1 x 10 image with 8 coloured pixels + }; + + case 'No arguments' => sub { + %args = (); + }; + + case 'Sets specific pixel count' => sub { + %check = %args = ( pixels => 10 ); + }; + + case 'Minimum pixel count' => sub { + %args = ( width => 10, height => 10, minpixels => 99 ); + $check{pixels} = 99; + }; + + case 'Maximum pixel count' => sub { + %args = ( width => 10, height => 10, maxpixels => 0 ); + $check{pixels} = 0; + }; + + case 'Conflicting values' => sub { + # minpixels wins + %args = ( width => 10, height => 10, maxpixels => 10, minpixels => 90 ); + $check{pixels} = 90; + }; + + it 'Sets the colors in the image' => sub { + rand_image( %args ); + is $pixels, $check{pixels} // 8; + }; +}; - ok !( -z $imagefile ); +describe 'Edge cases' => sub { + it 'Warns if it cannot load GD' => sub { + no strict 'refs'; + local *{'Data::Random::require'} = sub { die 'Died' }; + like warning { rand_image() }, qr/Died/; }; }; diff --git a/t/rand_set.t b/t/rand_set.t index c5ee5ff..9c0849f 100644 --- a/t/rand_set.t +++ b/t/rand_set.t @@ -85,6 +85,22 @@ describe 'Get random elements' => sub { } ok 1, 'pass'; }; + + }; + +}; + +describe 'Return by calling context' => sub { + before_each 'Seed' => sub { srand 1234 }; + + it 'Returns array reference in scalar context' => sub { + my $elems = rand_set( set => ['a' .. 'z'], size => 5, shuffle => 0 ); + is $elems, [qw( f h i t z )]; + }; + + it 'Returns array in array context' => sub { + my @elems = rand_set( set => ['a' .. 'z'], size => 5, shuffle => 0 ); + is \@elems, [qw( f h i t z )]; }; }; diff --git a/t/rand_time.t b/t/rand_time.t index 8f27f96..516b506 100644 --- a/t/rand_time.t +++ b/t/rand_time.t @@ -1,100 +1,85 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; use Test2::Tools::Spec; +BEGIN { use Test::MockTime qw( set_fixed_time ); } + use Data::Random qw( rand_time ); -use Test::MockTime qw( set_fixed_time ); use Time::Piece; -set_fixed_time('2018-01-21T18:54:00Z'); +describe 'Bad input' => sub { + my $time; + + it 'Warns if min time is later than max time' => sub { + like warning + { $time = rand_time( max => '10:00:00', min => '11:00:00' ) }, + qr/later than/; + + is $time, U(), 'Returns undefined'; + }; + + it 'Warns if min time is not a time' => sub { + like warning + { $time = rand_time( min => 'not a time' ) }, + qr/not in valid time format/; + + is $time, U(), 'Returns undefined'; + }; + + it 'Warns if max time is not a time' => sub { + like warning + { $time = rand_time( max => 'not a time' ) }, + qr/not in valid time format/; + + is $time, U(), 'Returns undefined'; + }; +}; -describe 'Test time parameters' => sub { - my ($case); +describe 'Time boundaries' => sub { + my ($min, $max, %args, %check); + + before_all 'Fix time' => sub { + set_fixed_time('1987-12-18T04:05:06Z'); + }; + + before_each 'Create Time::Piece objects' => sub { + $min = Time::Piece->strptime( $check{min} // '00:00:00', '%T' )->epoch; + $max = Time::Piece->strptime( $check{max} // '23:59:59', '%T' )->epoch; + + srand(12345); # Generates 05:24:28 + }; case 'No params' => sub { - $case = {}; + %check = %args = (); }; case 'With min' => sub { - $case = { min => '4:0:0' }; + %check = %args = ( min => '6:0:0' ); }; case 'With max' => sub { - $case ={ max => '4:0:0' }; + %check = %args = ( max => '4:0:0' ); }; case 'With min and max' => sub { - $case = { min => '9:0:0', max => '10:0:0' }; + %check = %args = ( min => '9:0:0', max => '10:0:0' ); }; - describe 'For each case' => { flat => 1}, sub { - my ($min_secs, $max_secs, $iterations); - - before_all 'Determine test granularity' => sub { - $min_secs = defined $case->{min} - ? _to_secs($case->{min}) : 0; - - $max_secs = defined $case->{max} - ? _to_secs($case->{max}) : _to_secs('23:59:59'); - - # Running once for every possible value doesn't actually - # guarantee that we will _get_ every possible value, of course, - # since it's a randomly generated time. Running 10 times for - # every possible value pretty much guarantees that, but it also - # takes forever. So let's run 10x in the case of automated - # testers (like CPAN Testers), and just half that many otherwise - # (to keep installs speedy). - - $iterations = $max_secs - $min_secs + 1; - $iterations *= $ENV{AUTOMATED_TESTING} ? 10 : .5; - }; - - tests 'Random time is between boundaries' => sub { - my $errors = 0; - - for ( 1 .. $iterations ) { - my $time = rand_time( %{$case} ); - my $secs = _to_secs($time); - - my $error = 0; - $error = 1 unless defined($secs) - and ($secs >= $min_secs) - and ($secs <= $max_secs); - - if ($error) { - $errors += 1; - note 'Failed with ' . $time; - } - } - ok $errors == 0, 'foo'; - }; + case 'With min and max as now' => sub { + %args = ( min => 'now', max => 'now' ); + %check = ( min => '04:05:06', max => '04:05:06' ); }; -}; -describe 'Test special parameters' => sub { - my ($case); + tests 'Random time is between boundaries' => sub { + my $rand_time = rand_time( %args ); - case 'With min and max set to now' => sub { - $case = { min => 'now', max => 'now' }; - }; + like $rand_time, qr/^\d{1,2}:\d{1,2}:\d{1,2}$/, 'rand_time format'; - tests 'Random time is now' => sub { - my $time = rand_time( %{$case} ); - is [ map { s/^0//; $_ } split /:/, $time ], - [ ( localtime() )[ 2, 1, 0 ] ], - 'Random time constrained to a second works'; + my $result = Time::Piece->strptime( $rand_time, '%T' )->epoch; + + note $rand_time; + cmp_ok $result, '>=', $min, 'rand_date >= minimum'; + cmp_ok $result, '<=', $max, 'rand_date <= maximum'; }; }; done_testing; - -sub _to_secs { - my $time = shift; - - my ( $hour, $min, $sec ) = split ( /\:/, $time ); - - return undef if ( $hour > 23 ) || ( $hour < 0 ); - return undef if ( $min > 59 ) || ( $min < 0 ); - return undef if ( $sec > 59 ) || ( $sec < 0 ); - - return $hour * 3600 + $min * 60 + $sec; -} diff --git a/t/rand_words.t b/t/rand_words.t index 93f423f..fd3b3b6 100644 --- a/t/rand_words.t +++ b/t/rand_words.t @@ -1,4 +1,4 @@ -use Test2::V0 -srand => 123456; +use Test2::V0; use Test2::Tools::Spec; use Test2::Plugin::DieOnFail; @@ -22,6 +22,8 @@ describe 'Single random word' => sub { close($fh); }; + before_each 'Set seed' => sub { srand 123456 }; + it 'Should return one word by default' => sub { foreach (1 .. $num_words) { my @words = rand_words( wordlist => $wordlist ); @@ -78,6 +80,37 @@ describe 'Single random word' => sub { cmp_ok $words[0], 'lt', $words[1], 'Words are ordered'; } }; + + it 'Can use default wordlist' => sub { + my @words = rand_words( + size => 2, + shuffle => 0, + ); + + is \@words, [qw( pickings unanalyzable )], 'Got right words'; + }; + + it 'Returns array reference in scalar context' => sub { + my $words = rand_words( + size => 2, + shuffle => 0, + ); + + is $words, [qw( pickings unanalyzable )], 'Got right words'; + }; + + it 'Can use existing WordList object' => sub { + require Data::Random::WordList; + + my @words = rand_words( + wordlist => Data::Random::WordList->new( wordlist => $wordlist ), + size => 2, + shuffle => 0, + ); + + is scalar(@words), 2, 'Got right number of words'; + cmp_ok $words[0], 'lt', $words[1], 'Words are ordered'; + }; }; done_testing;