blob: 6e8b60d00b60d241edfd49fb3d7666f705b3ac96 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
#!perl -T
use Test::More;
BEGIN {
unless ( $ENV{RELEASE_TESTING} ) {
plan skip_all => 'these tests are for release testing';
}
$ENV{PV_TEST_PERL} = 1;
}
use strict;
use warnings;
use Test::Requires {
'Test::Taint' => 0.02,
};
use Test::Fatal;
use Test::More;
use Params::Validate qw( validate validate_pos ARRAYREF );
taint_checking_ok('These tests are meaningless unless we are in taint mode.');
sub test1 {
my $def = $0;
tainted_ok( $def, 'make sure $def is tainted' );
# The spec is irrelevant, all that matters is that there's a
# tainted scalar as the default
my %p = validate( @_, { foo => { default => $def } } );
}
{
is(
exception { test1() },
undef,
'no taint error when we validate with tainted default value'
);
}
sub test2 {
return validate_pos( @_, { regex => qr/^b/ } );
}
SKIP:
{
skip 'This test only passes on Perl 5.14+', 1
unless $] >= 5.014;
my @p = 'cat';
taint(@p);
like(
exception { test2(@p) },
qr/\QParameter #1 ("cat") to main::test2 did not pass regex check/,
'no taint error when we validate with tainted value values being validated'
);
}
done_testing();
|
