jurij/Test-Expander
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

first commit

Browse Source
This commit is contained in:
Jurij Fajnberg
2021-11-01 17:16:06 +01:00
commit 717e9581ea
26 changed files with 2015 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
t/Test/Expander/Boilerplate.pm Normal file
View File

@ -0,0 +1,14 @@
package t::Test::Expander::Boilerplate;
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
sub new {
my ($class, @args) = @_;
return bless([\@args], $class);
}
1;

12
t/Test/Expander/NoCLASS/NoMETHOD.t Normal file
View File

@ -0,0 +1,12 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Expander;
is($CLASS, undef, 'there is no class corresponding to this test file');
done_testing();

28
t/Test/Expander/_error.t Normal file
View File

@ -0,0 +1,28 @@
#!/usr/bin/env perl
## no critic (ProtectPrivateSubs RequireLocalizedPunctuationVars)
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Expander::Constants qw($ERROR_WAS);
use constant TEST_CASES => {
'no exception' => { exception => '', args => [], output => '' },
'exception raised, no replacement required' => { exception => 'ABC', args => [], output => "${ERROR_WAS}ABC" },
'exception raised, replacement required' => { exception => 'ABC', args => [qw(B b)], output => "${ERROR_WAS}AbC" },
};
use Test::Builder::Tester tests => scalar(keys(%{TEST_CASES()}));
use Test::Expander;
foreach my $title (keys(%{TEST_CASES()})) {
test_out("ok 1 - $title");
$@ = TEST_CASES->{$title}->{exception};
is(
Test::Expander::_error(@{TEST_CASES->{$title}->{args}}),
TEST_CASES->{$title}->{output},
$title
);
test_test($title);
}

24
t/Test/Expander/_newTestMessage.t Normal file
View File

@ -0,0 +1,24 @@
#!/usr/bin/env perl
## no critic (ProtectPrivateSubs RequireLocalizedPunctuationVars)
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Expander::Constants qw($NEW_FAILED $NEW_SUCCEEDED);
use constant TEST_CASES => {
"'new' succeeded" => { exception => '', output => $NEW_SUCCEEDED },
"'new' failed" => { exception => 'ABC', output => $NEW_FAILED },
};
use Test::Builder::Tester tests => scalar(keys(%{TEST_CASES()}));
use Test::Expander;
foreach my $title (keys(%{TEST_CASES()})) {
test_out("ok 1 - $title");
$@ = TEST_CASES->{$title}->{exception};
my $expected = TEST_CASES->{$title}->{output} =~ s/%s/.*/gr;
like(Test::Expander::_newTestMessage('CLASS'), qr/$expected/, $title);
test_test($title);
}

99
t/Test/Expander/_setEnv.t Normal file
View File

@ -0,0 +1,99 @@
#!/usr/bin/env perl
## no critic (RequireLocalizedPunctuationVars)
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use File::chdir;
use Test::Expander -tempdir => {}, -srand => time;
can_ok($CLASS, $METHOD);
ok(-d $TEMP_DIR, "temporary directory '$TEMP_DIR' created");
my $classPath = $CLASS =~ s{::}{/}gr;
my $testPath = path($TEMP_DIR)->child('t');
$testPath->child($classPath)->mkpath;
{
local $CWD = $testPath->parent->stringify; ## no critic (ProhibitLocalVars)
my $testFile = path('t')->child($classPath)->child($METHOD . '.t')->stringify;
my $envFile = path('t')->child($classPath)->child($METHOD . '.env');
is(Test2::Plugin::SRand->from, 'import arg', "random seed is supplied as 'time'");
subtest 'env variable filled from a variable' => sub {
our $var = 'abc';
my $name = 'ABC';
my $value = '$' . __PACKAGE__ . '::var';
$envFile->spew("$name = $value\nJust a comment line");
%ENV = (xxx => 'yyy');
ok(lives { $METHOD_REF->($METHOD, $CLASS, $testFile) }, 'successfully executed');
is(\%ENV, { $name => lc($name) }, "'%ENV' has the expected content");
};
subtest 'env variable filled by a self-implemented sub' => sub {
my $name = 'ABC';
my $value = __PACKAGE__ . "::testEnv(lc('$name'))";
$envFile->spew("$name = $value");
%ENV = (xxx => 'yyy');
ok(lives { $METHOD_REF->($METHOD, $CLASS, $testFile) }, 'successfully executed');
is(\%ENV, { $name => lc($name) }, "'%ENV' has the expected content");
};
subtest "env variable filled by a 'File::Temp::tempdir'" => sub {
my $name = 'ABC';
my $value = 'File::Temp::tempdir';
$envFile->spew("$name = $value");
%ENV = (xxx => 'yyy');
ok(lives { $METHOD_REF->($METHOD, $CLASS, $testFile) }, 'successfully executed');
is([ keys(%ENV) ], [ $name ], "'%ENV' has the expected keys");
ok(-d $ENV{$name}, 'temporary directory exists');
};
subtest 'env file does not exist' => sub {
$envFile->remove;
%ENV = (xxx => 'yyy');
ok(lives { $METHOD_REF->($METHOD, $CLASS, $testFile) }, 'successfully executed');
is(\%ENV, { xxx => 'yyy' }, "'%ENV' remained unchanged");
};
subtest 'directory structure does not correspond to class hierarchy' => sub {
$envFile->remove;
%ENV = (xxx => 'yyy');
ok(lives { $METHOD_REF->($METHOD, 'ABC::' . $CLASS, $testFile) }, 'successfully executed');
is(\%ENV, { xxx => 'yyy' }, "'%ENV' remained unchanged");
};
subtest 'env files exist on multiple levels' => sub {
path($envFile->parent . '.env')->spew("A = '1'\nB = '2'");
path($envFile->parent->parent . '.env')->spew("C = '0'");
$envFile->spew("C = '3'");
%ENV = (xxx => 'yyy');
local $CWD = $TEMP_DIR; ## no critic (ProhibitLocalVars)
ok(lives { $METHOD_REF->($METHOD, $CLASS, $testFile) }, 'successfully executed');
is(\%ENV, { A => '1', B => '2', C => '3' }, "'%ENV' has the expected content");
};
subtest 'env file invalid' => sub {
my $name = 'ABC';
my $value = 'abc->';
$envFile->spew("$name = $value");
like(dies { $METHOD_REF->($METHOD, $CLASS, $testFile) }, qr/syntax error/, 'expected exception raised');
};
}
done_testing();
sub testEnv { return $_[0] } ## no critic (RequireArgUnpacking)

22
t/Test/Expander/_useImports.t Normal file
View File

@ -0,0 +1,22 @@
#!/usr/bin/env perl
## no critic (ProtectPrivateSubs)
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use constant TEST_CASES => {
'module version required' => { input => [ '1.22.333' ], output => ' 1.22.333' },
'single import but not a module version' => { input => [ 'x' ], output => '' },
'multiple imports' => { input => [ qw(x y) ], output => '' },
};
use Test::Builder::Tester tests => scalar(keys(%{TEST_CASES()}));
use Test::Expander;
foreach my $title (keys(%{TEST_CASES()})) {
test_out("ok 1 - $title");
is(Test::Expander::_useImports(TEST_CASES->{$title}->{input}), TEST_CASES->{$title}->{output}, $title);
test_test($title);
}

16
t/Test/Expander/compare_ok.t Normal file
View File

@ -0,0 +1,16 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Builder::Tester tests => 1;
use Test::Expander;
my $dir = path(__FILE__)->parent->child($METHOD);
my $title = 'execution';
test_out("ok 1 - $title");
compare_ok($dir->child('got'), $dir->child('expected'), $title);
test_test($title);

2
t/Test/Expander/compare_ok/expected Normal file
View File

@ -0,0 +1,2 @@
A
BC

2
t/Test/Expander/compare_ok/got Normal file
View File

@ -0,0 +1,2 @@
A
BC

15
t/Test/Expander/dies_ok.t Normal file
View File

@ -0,0 +1,15 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Builder::Tester tests => 1;
use Test::Expander;
my $title = 'execution';
test_out("ok 1 - $title");
dies_ok(sub { die() }, $title);
test_test($title);

98
t/Test/Expander/import.t Normal file
View File

@ -0,0 +1,98 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
my (@functions, @variables);
BEGIN {
use Const::Fast;
use File::Temp qw(tempdir tempfile);
use Path::Tiny qw(cwd path);
use Test::Output;
use Test::Warn;
use Test2::Tools::Explain;
use Test2::V0;
@functions = (
@{Const::Fast::EXPORT},
@{Test::Files::EXPORT},
@{Test::Output::EXPORT},
@{Test::Warn::EXPORT},
@{Test2::Tools::Explain::EXPORT},
@{Test2::V0::EXPORT},
qw(tempdir tempfile),
qw(cwd path),
qw(BAIL_OUT dies_ok is_deeply lives_ok new_ok require_ok use_ok),
);
@variables = qw($CLASS $METHOD $METHOD_REF $TEMP_DIR $TEMP_FILE);
}
use Scalar::Readonly qw(readonly_off);
use Test::Builder::Tester tests => @functions + @variables + 4;
use Test::Expander -target => 'Test::Expander',
-tempdir => { CLEANUP => 1 },
-tempfile => { UNLINK => 1 };
use Test::Expander::Constants qw($INVALID_VALUE $UNKNOWN_OPTION);
foreach my $function (sort @functions) {
my $title = "$CLASS->can('$function')";
test_out("ok 1 - $title");
can_ok($CLASS, $function);
test_test($title);
}
foreach my $variable (sort @variables) {
my $title = "$CLASS exports '$variable'";
test_out("ok 1 - $title");
ok(eval("defined($variable)"), $title); ## no critic (ProhibitStringyEval)
test_test($title);
}
my $title;
my $expected;
$title = "invalid option value of '-tempdir'";
$expected = $INVALID_VALUE =~ s/%s/.+/gr;
readonly_off($CLASS);
readonly_off($METHOD);
readonly_off($METHOD_REF);
readonly_off($TEMP_DIR);
readonly_off($TEMP_FILE);
test_out("ok 1 - $title");
like(dies { $CLASS->$METHOD(-tempdir => 1) }, qr/$expected/, $title);
test_test($title);
$title = "invalid option value of '-tempfile'";
$expected = $INVALID_VALUE =~ s/%s/.+/gr;
readonly_off($CLASS);
readonly_off($METHOD);
readonly_off($METHOD_REF);
readonly_off($TEMP_DIR);
readonly_off($TEMP_FILE);
test_out("ok 1 - $title");
like(dies { $CLASS->$METHOD(-tempfile => 1) }, qr/$expected/, $title);
test_test($title);
$title = 'unknown option with some value';
$expected = $UNKNOWN_OPTION =~ s/%s/.+/gr;
readonly_off($CLASS);
readonly_off($METHOD);
readonly_off($METHOD_REF);
readonly_off($TEMP_DIR);
readonly_off($TEMP_FILE);
test_out("ok 1 - $title");
like(dies { $CLASS->$METHOD(unknown => 1) }, qr/$expected/, $title);
test_test($title);
$title = 'unknown option without value';
$expected = $UNKNOWN_OPTION =~ s/%s/.+/r =~ s/%s//r;
readonly_off($CLASS);
readonly_off($METHOD);
readonly_off($METHOD_REF);
readonly_off($TEMP_DIR);
readonly_off($TEMP_FILE);
test_out("ok 1 - $title");
like(dies { $CLASS->$METHOD('unknown') }, qr/$expected/, $title);
test_test($title);

18
t/Test/Expander/is_deeply.t Normal file
View File

@ -0,0 +1,18 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Clone qw(clone);
use Test::Builder::Tester tests => 1;
use Test::Expander;
my $title = 'execution';
test_out("ok 1 - $title");
my $got = bless({A => 0, B => [(0 .. 1)]}, 'some class');
my $expected = clone($got);
is_deeply($got, $expected, $title);
test_test($title);

15
t/Test/Expander/lives_ok.t Normal file
View File

@ -0,0 +1,15 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Builder::Tester tests => 1;
use Test::Expander;
my $title = 'execution';
test_out("ok 1 - $title");
lives_ok(sub {}, $title);
test_test($title);

24
t/Test/Expander/new_ok.t Normal file
View File

@ -0,0 +1,24 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use constant {
CLASS => 't::Test::Expander::Boilerplate',
TEST_CASES => {
'no args' => undef,
'args supplied' => [ 0 .. 1 ],
},
};
use Test::Builder::Tester tests => scalar(keys(%{TEST_CASES()}));
use Test::Expander;
use t::Test::Expander::Boilerplate;
foreach my $title (keys(%{TEST_CASES()})) {
test_out("ok 1 - An object of class '@{[CLASS]}' isa '@{[CLASS]}'");
new_ok(CLASS, TEST_CASES->{$title}, $title);
test_test($title);
}

17
t/Test/Expander/require_ok.t Normal file
View File

@ -0,0 +1,17 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Builder::Tester tests => 1;
use Test::Expander;
use constant CLASS => 't::Test::Expander::Boilerplate';
my $title = "require @{[CLASS]}";
test_out("ok 1 - $title;");
require_ok(CLASS);
test_test($title);

16
t/Test/Expander/throws_ok.t Normal file
View File

@ -0,0 +1,16 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Builder::Tester tests => 1;
use Test::Expander;
my $title = 'execution';
test_out("ok 1 - $title");
my $expected = 'DIE TEST';
throws_ok(sub { die($expected) }, $expected, $title);
test_test($title);

17
t/Test/Expander/use_ok.t Normal file
View File

@ -0,0 +1,17 @@
#!/usr/bin/env perl
use v5.14;
use warnings
FATAL => qw(all),
NONFATAL => qw(deprecated exec internal malloc newline once portable redefine recursion uninitialized);
use Test::Builder::Tester tests => 1;
use Test::Expander;
use constant CLASS => 't::Test::Expander::Boilerplate';
my $title = "use @{[CLASS]}";
test_out("ok 1 - $title;");
use_ok(CLASS);
test_test($title);