view release on metacpan or  search on metacpan

misc/pX/Common/Regexp-Test-Perl5Tests/t/op/taint.t  view on Meta::CPAN

#!./perl -T
#
# Taint tests by Tom Phoenix <rootbeer@teleport.com>.
#
# I don't claim to know all about tainting. If anyone sees
# tests that I've missed here, please add them. But this is
# better than having no tests at all, right?
#

BEGIN {
    chdir 't' if -d 't';
#    @INC = '../lib';
}

use strict;
use Config;
use File::Spec::Functions;

BEGIN { require './test.pl'; }
plan tests => 246;


$| = 1;

use vars qw($ipcsysv); # did we manage to load IPC::SysV?

BEGIN {
  if ($^O eq 'VMS' && !defined($Config{d_setenv})) {
      $ENV{PATH} = $ENV{PATH};
      $ENV{TERM} = $ENV{TERM} ne ''? $ENV{TERM} : 'dummy';
  }
  if ($Config{'extensions'} =~ /\bIPC\/SysV\b/
      && ($Config{d_shm} || $Config{d_msg})) {
      eval { require IPC::SysV };
      unless ($@) {
	  $ipcsysv++;
	  IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU IPC_NOWAIT));
      }
  }
}

my $Is_MacOS    = $^O eq 'MacOS';
my $Is_VMS      = $^O eq 'VMS';
my $Is_MSWin32  = $^O eq 'MSWin32';
my $Is_NetWare  = $^O eq 'NetWare';
my $Is_Dos      = $^O eq 'dos';
my $Is_Cygwin   = $^O eq 'cygwin';
my $Invoke_Perl = $Is_VMS      ? 'MCR Sys$Disk:[]Perl.' :
                  $Is_MSWin32  ? '.\perl'               :
                  $Is_MacOS    ? ':perl'                :
                  $Is_NetWare  ? 'perl'                 : 
                                 './perl'               ;
my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;

if ($Is_VMS) {
    my (%old, $x);
    for $x ('DCL$PATH', @MoreEnv) {
	($old{$x}) = $ENV{$x} =~ /^(.*)$/ if exists $ENV{$x};
    }
    eval <<EndOfCleanup;
	END {
	    \$ENV{PATH} = '' if $Config{d_setenv};
	    warn "# Note: logical name 'PATH' may have been deleted\n";
	    \@ENV{keys %old} = values %old;
	}
EndOfCleanup
}

# Sources of taint:
#   The empty tainted value, for tainting strings
my $TAINT = substr($^X, 0, 0);
#   A tainted zero, useful for tainting numbers
my $TAINT0;
{
    no warnings;
    $TAINT0 = 0 + $TAINT;
}

# This taints each argument passed. All must be lvalues.
# Side effect: It also stringifies them. :-(
sub taint_these (@) {
    for (@_) { $_ .= $TAINT }
}

# How to identify taint when you see it
sub any_tainted (@) {
    not eval { join("",@_), kill 0; 1 };
}
sub tainted ($) {
    any_tainted @_;
}
sub all_tainted (@) {
    for (@_) { return 0 unless tainted $_ }
    1;
}


sub test ($;$) {
    my($ok, $diag) = @_;

    my $curr_test = curr_test();

    if ($ok) {
	print "ok $curr_test\n";
    } else {
	print "not ok $curr_test\n";
        printf "# Failed test at line %d\n", (caller)[2];
	for (split m/^/m, $diag) {
	    print "# $_";
	}
	print "\n" unless
	    $diag eq ''
	    or substr($diag, -1) eq "\n";
    }

    next_test();

    return $ok;
}

# We need an external program to call.
my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : $Is_MacOS ? ":echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));