package RandomLine;
use base qw/Test::Class/;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use File::Temp qw/tempfile/;
use Set::Scalar;
use Test::Warn;
use Test::ManyParams;
use File::Random qw/random_line/;
use constant LINES => <<'EOF';
Random
Lines
can
contain
randomly
appearing things like
PI = 3.1415926535
but of course that's not neccessary
EOF
use constant WRONG_PARAMS => (undef, '', '&');
use constant SAMPLE_SIZE => 200;
sub fill_tempfile : Test(setup) {
my $self = shift;
(my $normal_fh, $self->{normal_file}) = tempfile();
(undef, $self->{empty_file}) = tempfile();
print $normal_fh LINES;
}
sub clear_tempfile : Test(teardown) {
my $self = shift;
close $self->{'normal_file'};
close $self->{'empty_file'};
}
sub empty_file_returns_undef : Test(1) {
my $self = shift;
is random_line($self->{empty_file}), undef, "random_file( Empty file )";
}
sub lines_are_the_expected_ones : Test(1) {
my $self = shift;
my $exp = Set::Scalar->new( map {"$_\n"} split /\n/, LINES);
my $got = Set::Scalar->new();
$got->insert( scalar random_line($self->{normal_file}) ) for (1 .. SAMPLE_SIZE);
is $got, $exp, "random_line( Normal File )";
}
sub multiple_lines_are_the_expected_ones : Test(2) {
my $self = shift;
my $exp = Set::Scalar->new( map {"$_\n"} split /\n/, LINES);
my $got = Set::Scalar->new();
$got->insert( random_line($self->{normal_file},3) ) for (1 .. SAMPLE_SIZE()/3);
is $got, $exp, "random_line( Normal File, 3 ) [expected files]";
$got->clear;
for (1 .. SAMPLE_SIZE()/3) {
my ($line1, $line2, $line3) = random_line($self->{normal_file});
$got->insert($line1, $line2, $line3);
}
is $got, $exp, '($line1, $line2, $line3) = random_line $fname [expected files]';
}
sub multiple_lines_are_the_expected_ones_random_line_with_sample_size : Test(1) {
my $self = shift;
my $exp = Set::Scalar->new( map {"$_\n"} split /\n/, LINES);
my $got = Set::Scalar->new(random_line($self->{normal_file}, SAMPLE_SIZE()));
is $got, $exp, "random_line( Normal File, 3 ) [expected files]";
}
sub get_really_lines : Test(8) {
my $self = shift;
SIZE_IS_KNOWN: {
my ($line1, $line2, $line3) = random_line($self->{normal_file},3);
ok defined($line1), "1st returned line of random_line should be defined";
ok defined($line2), "2nd returned line of random_line should be defined";
ok defined($line3), "3rd returned line of random_line should be defined";
ok( ($line1 ne $line2 or $line1 ne $line3),
"3 random lines should be a bit different" );
}
SIZE_IS_UNKNOWN: {
my ($line1, $line2, $line3) = random_line($self->{normal_file});
ok defined($line1), "1st returned line of random_line should be defined";
ok defined($line2), "2nd returned line of random_line should be defined";
ok defined($line3), "3rd returned line of random_line should be defined";
ok( ($line1 ne $line2 or $line1 ne $line3),
"3 random lines should be a bit different" );
}
}
sub warns_if_called_with_line_nr_in_scalar_context : Test(1) {
my $self = shift;
warning_like {scalar random_line($self->{normal_file},3)}
{carped => qr/called in scalar context/},
"should give a warning random_line(fname,3) is called in scalar context";
}
sub warns_if_zero_random_lines : Test(1) {
my $self = shift();
warning_like { (random_line($self->{normal_file},0)) }
{carped => qr/0 random lines/},
"should give a warning random_line(fname,0)";
}
sub warns_not_if_called_in_list_context_without_line_nr_specification : Test(1) {
my $self = shift();
warnings_are { [ random_line($self->{normal_file}) ] }
[],
"should give a warning if random_line(fname) in list context";
}
sub nr_of_lines_greater_than_lines_in_file : Test(2) {
my $self = shift;
my @line = random_line($self->{normal_file},100);
ok @line == 100, "random_line(file, 100) should return a list of 100 elements";
all_ok {defined($_[0])} \@line, "random_line(file, 100) - all lines should be defined";
}
sub wrong_parameters : Test(5) {
my $self = shift;
no warnings; # $_ shall be undefined for a moment !
foreach (WRONG_PARAMS) {
dies_ok(sub {random_line($_)}, "random_line( '$_' ) should die");
next unless defined;
dies_ok(sub {(random_line($self->{normal_file},$_))},
"random_line(fname, '$_' ) should die");
}
use warnings; # warnings back
}
1;
syntax highlighted by Code2HTML, v. 0.9.1