This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove vestigial uses of PRIVSHIFT
[perl5.git] / t / op / taint.t
index de30a9b..101c6da 100644 (file)
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
+    require './loc_tools.pl';
     set_up_inc('../lib');
 }
 
 use strict;
 use Config;
 
-plan tests => 801;
+plan tests => 808;
 
 $| = 1;
 
@@ -298,7 +299,7 @@ my $TEST = 'TEST';
     is($one, 'a',      "$desc: \$1 value");
 
   SKIP: {
-        skip 'No locale testing without d_setlocale', 10 if(!$Config{d_setlocale});
+        skip 'Locales not available', 10 unless locales_enabled('LC_CTYPE');
 
         $desc = "match with pattern tainted via locale";
 
@@ -351,7 +352,7 @@ my $TEST = 'TEST';
     is($one, 'd',      "$desc: \$1 value");
 
   SKIP: {
-        skip 'No locale testing without d_setlocale', 12 if(!$Config{d_setlocale});
+        skip 'Locales not available', 12 unless locales_enabled('LC_CTYPE');
 
         $desc = "match with pattern tainted via locale, list cxt";
 
@@ -503,7 +504,7 @@ my $TEST = 'TEST';
     is($one, 'abcd',   "$desc: \$1 value");
 
   SKIP: {
-        skip 'No locale testing without d_setlocale', 18 if(!$Config{d_setlocale});
+        skip 'Locales not available', 18 unless locales_enabled('LC_CTYPE');
 
         $desc = "substitution with pattern tainted via locale";
 
@@ -687,7 +688,7 @@ my $TEST = 'TEST';
        is($one, 'a',      "$desc: \$1 value");
 
   SKIP: {
-        skip 'No locale testing without d_setlocale', 10 if(!$Config{d_setlocale});
+        skip 'Locales not available', 10 unless locales_enabled('LC_CTYPE');
 
         $desc = "use re 'taint': match with pattern tainted via locale";
 
@@ -740,7 +741,7 @@ my $TEST = 'TEST';
        is($one, 'd',      "$desc: \$1 value");
 
   SKIP: {
-        skip 'No locale testing without d_setlocale', 12 if(!$Config{d_setlocale});
+        skip 'Locales not available', 12 unless locales_enabled('LC_CTYPE');
 
         $desc = "use re 'taint': match with pattern tainted via locale, list cxt";
 
@@ -893,7 +894,7 @@ my $TEST = 'TEST';
        is($one, 'abcd',   "$desc: \$1 value");
 
   SKIP: {
-        skip 'No locale testing without d_setlocale', 18 if(!$Config{d_setlocale});
+        skip 'Locales not available', 18 unless locales_enabled('LC_CTYPE');
 
         $desc = "use re 'taint': substitution with pattern tainted via locale";
 
@@ -1973,9 +1974,16 @@ foreach my $ord (78, 163, 256) {
           # return a null pointer, which Perl converts into undef. We assume
           # for now that all such platforms support glibc-style selection of
           # a different hashing algorithm.
+          # glibc supports MD5, but OpenBSD only supports Blowfish.
           my $alg = '';       # Use default algorithm
-          if ( !defined(crypt("ab", "cd")) ) {
-              $alg = '$5$';   # Use SHA-256
+          if ( !defined(crypt("ab", $alg."cd")) ) {
+              $alg = '$5$';   # Try SHA-256
+          }
+          if ( !defined(crypt("ab", $alg."cd")) ) {
+              $alg = '$2b$12$FPWWO2RJ3CK4FINTw0Hi';  # Try Blowfish
+          }
+          if ( !defined(crypt("ab", $alg."cd")) ) {
+              $alg = ''; # Nothing worked.  Back to default
           }
           my $x = crypt($_[0], $alg . $_[1]);
           $x
@@ -2297,7 +2305,7 @@ pass("no death when TARG of ref is tainted");
 }
 
 SKIP: {
-    skip 'No locale testing without d_setlocale', 4 if(!$Config{d_setlocale});
+    skip 'Locales not available', 4 unless locales_enabled('LC_CTYPE');
 
     use feature 'fc';
     use locale;
@@ -2348,6 +2356,42 @@ is eval { eval $::x.1 }, 1, 'reset does not taint undef';
         'tainted constant as logop condition should not prevent "use"';
 }
 
+# optimised SETi etc need to handle tainting
+
+{
+    my ($i1, $i2, $i3) = (1, 1, 1);
+    my ($n1, $n2, $n3) = (1.1, 1.1, 1.1);
+    my $tn = $TAINT0 + 1.1;
+
+    $i1 = $TAINT0 + 2;
+    is_tainted $i1, "+ SETi";
+    $i2 = $TAINT0 - 2;
+    is_tainted $i2, "- SETi";
+    $i3 = $TAINT0 * 2;
+    is_tainted $i3, "* SETi";
+
+    $n1 = $tn + 2.2;
+    is_tainted $n1, "+ SETn";
+    $n2 = $tn - 2.2;
+    is_tainted $n2, "- SETn";
+    $n3 = $tn * 2.2;
+    is_tainted $n3, "* SETn";
+}
+
+# check that localizing something with get magic (e.g. taint) doesn't
+# upgrade pIOK to IOK
+
+{
+    local our $x = 1.1 + $TAINT0;  # $x should be NOK
+    my $ix = int($x);          #          now NOK, pIOK
+    {
+        local $x = 0;
+    }
+    my $x1 = $x * 1;
+    isnt($x, 1); # it should be 1.1, not 1
+}
+
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};