use strict;
use Config;
+my $test = 177;
+sub ok {
+ my($ok, $name) = @_;
+
+ # You have to do it this way or VMS will get confused.
+ print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
+
+ printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+ $test++;
+ return $ok;
+}
+
+
$| = 1;
# We do not want the whole taint.t to fail
close PROG;
my $echo = "$Invoke_Perl $ECHO";
-print "1..174\n";
+print "1..179\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
delete @ENV{@MoreEnv};
$ENV{TERM} = 'dumb';
- if ($Is_Cygwin) {
+ if ($Is_Cygwin && ! -f 'cygwin1.dll') {
system("/usr/bin/cp /usr/bin/cygwin1.dll .") &&
die "$0: failed to cp cygwin1.dll: $!\n";
END { unlink "cygwin1.dll" } # yes, done for all platforms...
print "ok 174\n";
}
+
+{
+ # Bug ID 20010730.010
+
+ my $i = 0;
+
+ sub Tie::TIESCALAR {
+ my $class = shift;
+ my $arg = shift;
+
+ bless \$arg => $class;
+ }
+
+ sub Tie::FETCH {
+ $i ++;
+ ${$_ [0]}
+ }
+
+
+ package main;
+
+ my $bar = "The Big Bright Green Pleasure Machine";
+ taint_these $bar;
+ tie my ($foo), Tie => $bar;
+
+ my $baz = $foo;
+
+ print $i == 1 ? "ok 175\n" : "not ok 175\n"
+
+}
+
+{
+ # Check that all environment variables are tainted.
+ my @untainted;
+ while (my ($k, $v) = each %ENV) {
+ if (!tainted($v) &&
+ # These we have untainted explicitly earlier.
+ $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|TEMP|TERM|TMP)$/) {
+ push @untainted, "# '$k' = '$v'\n";
+ }
+ }
+ print @untainted == 0 ? "ok 176\n" : "not ok 176\n";
+ print "# untainted:\n", @untainted if @untainted;
+}
+
+
+ok( ${^TAINT}, '$^TAINT is on' );
+
+eval { ${^TAINT} = 0 };
+ok( ${^TAINT}, '$^TAINT is not assignable' );
+ok( $@ =~ /^Modification of a read-only value attempted/,
+ 'Assigning to ${^TAINT} fails' );
+