Codebase list libparams-validate-perl / 171d3e5
Move xt/release to xt/author Dave Rolsky 8 years ago
10 changed file(s) with 206 addition(s) and 206 deletion(s). Raw diff Collapse all Expand all
+91
-0
xt/author/memory-leak.t less more
0 use strict;
1 use warnings;
2
3 use Test::LeakTrace qw( no_leaks_ok );
4 use Test::More;
5
6 use Params::Validate qw( validate );
7
8 subtest(
9 'callback with default error' => sub {
10 no_leaks_ok( sub { val1( foo => 42 ); }, 'validation passes' );
11 local $TODO = 'Not sure if all the leaks are in Carp or not';
12 no_leaks_ok(
13 sub {
14 eval { val1( foo => 'forty two' ) };
15 },
16 'validation fails'
17 );
18 },
19 );
20
21 subtest(
22 'callback that dies with string' => sub {
23 no_leaks_ok( sub { val2( foo => 42 ); }, 'validation passes' );
24 local $TODO = 'Not sure if all the leaks are in Carp or not';
25 no_leaks_ok(
26 sub {
27 eval { val2( foo => 'forty two' ) };
28 },
29 'validation fails'
30 );
31 },
32 );
33
34 subtest(
35 'callback that dies with object' => sub {
36 no_leaks_ok( sub { val3( foo => 42 ); }, 'validation passes' );
37 no_leaks_ok(
38 sub {
39 eval { val3( foo => 'forty two' ) };
40 },
41 'validation fails'
42 );
43 },
44 );
45
46 done_testing();
47
48 sub val1 {
49 validate(
50 @_,
51 {
52 foo => {
53 callbacks => {
54 'is int' => sub { $_[0] =~ /^[0-9]+$/ }
55 }
56 },
57 },
58 );
59 }
60
61 sub val2 {
62 validate(
63 @_,
64 {
65 foo => {
66 callbacks => {
67 'is int' => sub {
68 $_[0] =~ /^[0-9]+$/ or die "$_[0] is not an integer";
69 }
70 }
71 },
72 },
73 );
74 }
75
76 sub val3 {
77 validate(
78 @_,
79 {
80 foo => {
81 callbacks => {
82 'is int' => sub {
83 $_[0] =~ /^[0-9]+$/
84 or die { error => "$_[0] is not an integer" };
85 }
86 }
87 },
88 },
89 );
90 }
+20
-0
xt/author/pp-is-loaded.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN {
6 $ENV{PV_TEST_PERL} = 1;
7 $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
8 }
9
10 use Module::Implementation 0.04 ();
11 use Params::Validate;
12
13 is(
14 Module::Implementation::implementation_for('Params::Validate'),
15 'PP',
16 'PP implementation is loaded when env var is set'
17 );
18
19 done_testing();
+17
-0
xt/author/xs-is-loaded.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN { $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1 }
6
7 use Module::Implementation 0.04 ();
8 use Params::Validate;
9
10 is(
11 Module::Implementation::implementation_for('Params::Validate'),
12 'XS',
13 'XS implementation is loaded by default'
14 );
15
16 done_testing();
+26
-0
xt/author/xs-segfault.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN {
6 $ENV{PARAMS_VALIDATE_IMPLEMENTATION} = 'XS';
7 $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
8 }
9
10 use Params::Validate qw( validate SCALAR );
11
12 eval { foo( { a => 1 } ) };
13
14 ok(1, 'did not segfault');
15
16 done_testing();
17
18 sub foo {
19 validate(
20 @_,
21 {
22 a => { type => SCALAR, depends => ['%s%s%s'] },
23 }
24 );
25 }
+52
-0
xt/author/xs-stack-realloc.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN {
6 $ENV{PARAMS_VALIDATE_IMPLEMENTATION} = 'XS';
7 $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
8 }
9
10 use Params::Validate qw( validate_with );
11
12 my $alloc_size;
13 for my $i ( 0 .. 15 ) {
14 $alloc_size = 2**$i;
15 test_array_spec(undef);
16 }
17
18 ok( 1, 'array validation succeeded with stack realloc' );
19
20 for my $i ( 0 .. 15 ) {
21 $alloc_size = 2**$i;
22 test_hash_spec( a => undef );
23 }
24
25 ok( 1, 'hash validation succeeded with stack realloc' );
26
27 done_testing();
28
29 sub grow_stack {
30 my @stuff = (1) x $alloc_size;
31
32 # "validation" always succeeds - we just need the stack to grow inside a
33 # callback to trigger the bug.
34 return 1;
35 }
36
37 sub test_array_spec {
38 my @args = validate_with(
39 params => \@_,
40 spec => [ { callbacks => { grow_stack => \&grow_stack } } ],
41 );
42 }
43
44 sub test_hash_spec {
45 my %args = validate_with(
46 params => \@_,
47 spec => {
48 a => { callbacks => { grow_stack => \&grow_stack } },
49 },
50 );
51 }
+0
-91
xt/release/memory-leak.t less more
0 use strict;
1 use warnings;
2
3 use Test::LeakTrace qw( no_leaks_ok );
4 use Test::More;
5
6 use Params::Validate qw( validate );
7
8 subtest(
9 'callback with default error' => sub {
10 no_leaks_ok( sub { val1( foo => 42 ); }, 'validation passes' );
11 local $TODO = 'Not sure if all the leaks are in Carp or not';
12 no_leaks_ok(
13 sub {
14 eval { val1( foo => 'forty two' ) };
15 },
16 'validation fails'
17 );
18 },
19 );
20
21 subtest(
22 'callback that dies with string' => sub {
23 no_leaks_ok( sub { val2( foo => 42 ); }, 'validation passes' );
24 local $TODO = 'Not sure if all the leaks are in Carp or not';
25 no_leaks_ok(
26 sub {
27 eval { val2( foo => 'forty two' ) };
28 },
29 'validation fails'
30 );
31 },
32 );
33
34 subtest(
35 'callback that dies with object' => sub {
36 no_leaks_ok( sub { val3( foo => 42 ); }, 'validation passes' );
37 no_leaks_ok(
38 sub {
39 eval { val3( foo => 'forty two' ) };
40 },
41 'validation fails'
42 );
43 },
44 );
45
46 done_testing();
47
48 sub val1 {
49 validate(
50 @_,
51 {
52 foo => {
53 callbacks => {
54 'is int' => sub { $_[0] =~ /^[0-9]+$/ }
55 }
56 },
57 },
58 );
59 }
60
61 sub val2 {
62 validate(
63 @_,
64 {
65 foo => {
66 callbacks => {
67 'is int' => sub {
68 $_[0] =~ /^[0-9]+$/ or die "$_[0] is not an integer";
69 }
70 }
71 },
72 },
73 );
74 }
75
76 sub val3 {
77 validate(
78 @_,
79 {
80 foo => {
81 callbacks => {
82 'is int' => sub {
83 $_[0] =~ /^[0-9]+$/
84 or die { error => "$_[0] is not an integer" };
85 }
86 }
87 },
88 },
89 );
90 }
+0
-20
xt/release/pp-is-loaded.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN {
6 $ENV{PV_TEST_PERL} = 1;
7 $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
8 }
9
10 use Module::Implementation 0.04 ();
11 use Params::Validate;
12
13 is(
14 Module::Implementation::implementation_for('Params::Validate'),
15 'PP',
16 'PP implementation is loaded when env var is set'
17 );
18
19 done_testing();
+0
-17
xt/release/xs-is-loaded.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN { $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1 }
6
7 use Module::Implementation 0.04 ();
8 use Params::Validate;
9
10 is(
11 Module::Implementation::implementation_for('Params::Validate'),
12 'XS',
13 'XS implementation is loaded by default'
14 );
15
16 done_testing();
+0
-26
xt/release/xs-segfault.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN {
6 $ENV{PARAMS_VALIDATE_IMPLEMENTATION} = 'XS';
7 $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
8 }
9
10 use Params::Validate qw( validate SCALAR );
11
12 eval { foo( { a => 1 } ) };
13
14 ok(1, 'did not segfault');
15
16 done_testing();
17
18 sub foo {
19 validate(
20 @_,
21 {
22 a => { type => SCALAR, depends => ['%s%s%s'] },
23 }
24 );
25 }
+0
-52
xt/release/xs-stack-realloc.t less more
0 use strict;
1 use warnings;
2
3 use Test::More;
4
5 BEGIN {
6 $ENV{PARAMS_VALIDATE_IMPLEMENTATION} = 'XS';
7 $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
8 }
9
10 use Params::Validate qw( validate_with );
11
12 my $alloc_size;
13 for my $i ( 0 .. 15 ) {
14 $alloc_size = 2**$i;
15 test_array_spec(undef);
16 }
17
18 ok( 1, 'array validation succeeded with stack realloc' );
19
20 for my $i ( 0 .. 15 ) {
21 $alloc_size = 2**$i;
22 test_hash_spec( a => undef );
23 }
24
25 ok( 1, 'hash validation succeeded with stack realloc' );
26
27 done_testing();
28
29 sub grow_stack {
30 my @stuff = (1) x $alloc_size;
31
32 # "validation" always succeeds - we just need the stack to grow inside a
33 # callback to trigger the bug.
34 return 1;
35 }
36
37 sub test_array_spec {
38 my @args = validate_with(
39 params => \@_,
40 spec => [ { callbacks => { grow_stack => \&grow_stack } } ],
41 );
42 }
43
44 sub test_hash_spec {
45 my %args = validate_with(
46 params => \@_,
47 spec => {
48 a => { callbacks => { grow_stack => \&grow_stack } },
49 },
50 );
51 }