summaryrefslogtreecommitdiff
path: root/t/release-pp-19-untaint.t
diff options
context:
space:
mode:
Diffstat (limited to 't/release-pp-19-untaint.t')
-rw-r--r--t/release-pp-19-untaint.t99
1 files changed, 99 insertions, 0 deletions
diff --git a/t/release-pp-19-untaint.t b/t/release-pp-19-untaint.t
new file mode 100644
index 0000000..42ee82d
--- /dev/null
+++ b/t/release-pp-19-untaint.t
@@ -0,0 +1,99 @@
+#!/usr/bin/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 Params::Validate qw(validate validate_pos);
+use Test::More;
+
+taint_checking_ok('These tests are meaningless unless we are in taint mode.');
+
+{
+ my $value = 7;
+ taint($value);
+
+ tainted_ok( $value, 'make sure $value is tainted' );
+
+ my @p = ( value => $value );
+ my %p = validate(
+ @p, {
+ value => {
+ regex => qr/^\d+$/,
+ untaint => 1,
+ },
+ },
+ );
+
+ untainted_ok( $p{value}, 'value is untainted after validation' );
+}
+
+{
+ my $value = 'foo';
+
+ taint($value);
+
+ tainted_ok( $value, 'make sure $value is tainted' );
+
+ my @p = ($value);
+ my ($new_value) = validate_pos(
+ @p, {
+ regex => qr/foo/,
+ untaint => 1,
+ },
+ );
+
+ untainted_ok( $new_value, 'value is untainted after validation' );
+}
+
+{
+ my $value = 7;
+ taint($value);
+
+ tainted_ok( $value, 'make sure $value is tainted' );
+
+ my @p = ( value => $value );
+ my %p = validate(
+ @p, {
+ value => {
+ regex => qr/^\d+$/,
+ },
+ },
+ );
+
+ tainted_ok( $p{value}, 'value is still tainted after validation' );
+}
+
+{
+ my $value = 'foo';
+
+ taint($value);
+
+ tainted_ok( $value, 'make sure $value is tainted' );
+
+ my @p = ($value);
+ my ($new_value) = validate_pos(
+ @p, {
+ regex => qr/foo/,
+ },
+ );
+
+ tainted_ok( $new_value, 'value is still tainted after validation' );
+}
+
+done_testing();
+