This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Part Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Tue, 11 Sep 2001 06:23:39 +0000 (06:23 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Tue, 11 Sep 2001 06:23:39 +0000 (06:23 +0000)
p4raw-id: //depot/perlio@11995

1  2 
ext/POSIX/sigaction.t
lib/CGI/t/carp.t
lib/File/Find/taint.t
t/op/crypt.t
t/op/utf8decode.t

index 70e8e19,0000000..1045db6
mode 100644,000000..100644
--- /dev/null
@@@ -1,133 -1,0 +1,133 @@@
-     if ($^O eq 'linux') {
-       print "ok 6 # Skip: sigaction() broken in $^O\n";
 +#!./perl
 +
 +BEGIN {
 +      chdir 't' if -d 't';
 +      unshift @INC, '../lib';
 +}
 +
 +BEGIN{
 +      # Don't do anything if POSIX is missing, or sigaction missing.
 +      eval { use POSIX; };
 +      if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare') {
 +              print "1..0\n";
 +              exit 0;
 +      }
 +}
 +
 +use strict;
 +use vars qw/$bad7 $ok10 $bad18 $ok/;
 +
 +$^W=1;
 +
 +print "1..18\n";
 +
 +sub IGNORE {
 +      $bad7=1;
 +}
 +
 +sub DEFAULT {
 +      $bad18=1;
 +}
 +
 +sub foo {
 +      $ok=1;
 +}
 +
 +my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
 +my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
 +
 +{
 +      my $bad;
 +      local($SIG{__WARN__})=sub { $bad=1; };
 +      sigaction(SIGHUP, $newaction, $oldaction);
 +      if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
 +}
 +
 +if($oldaction->{HANDLER} eq 'DEFAULT' ||
 +   $oldaction->{HANDLER} eq 'IGNORE')
 +  { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"}
 +print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
 +
 +sigaction(SIGHUP, $newaction, $oldaction);
 +if($oldaction->{HANDLER} eq '::foo')
 +  { print "ok 4\n" } else { print "not ok 4\n"}
 +if($oldaction->{MASK}->ismember(SIGUSR1))
 +  { print "ok 5\n" } else { print "not ok 5\n"}
 +if($oldaction->{FLAGS}) {
++    if ($^O eq 'linux' || $^O eq 'unicos') {
++      print "ok 6 # Skip: sigaction() thinks different in $^O\n";
 +    } else {
 +      print "not ok 6\n";
 +    }
 +} else {
 +    print "ok 6\n";
 +}
 +
 +$newaction=POSIX::SigAction->new('IGNORE');
 +sigaction(SIGHUP, $newaction);
 +kill 'HUP', $$;
 +print $bad7 ? "not ok 7\n" : "ok 7\n";
 +
 +print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
 +sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
 +print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
 +
 +$newaction=POSIX::SigAction->new(sub { $ok10=1; });
 +sigaction(SIGHUP, $newaction);
 +{
 +      local($^W)=0;
 +      kill 'HUP', $$;
 +}
 +print $ok10 ? "ok 10\n" : "not ok 10\n";
 +
 +print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
 +
 +sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
 +# Make sure the signal mask gets restored after sigaction croak()s.
 +eval {
 +      my $act=POSIX::SigAction->new('::foo');
 +      delete $act->{HANDLER};
 +      sigaction(SIGINT, $act);
 +};
 +kill 'HUP', $$;
 +print $ok ? "ok 12\n" : "not ok 12\n";
 +
 +undef $ok;
 +# Make sure the signal mask gets restored after sigaction returns early.
 +my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
 +kill 'HUP', $$;
 +print !$x && $ok ? "ok 13\n" : "not ok 13\n";
 +
 +$SIG{HUP}=sub {};
 +sigaction(SIGHUP, $newaction, $oldaction);
 +print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
 +
 +eval {
 +      sigaction(SIGHUP, undef, $oldaction);
 +};
 +print $@ ? "not ok 15\n" : "ok 15\n";
 +
 +eval {
 +      sigaction(SIGHUP, 0, $oldaction);
 +};
 +print $@ ? "not ok 16\n" : "ok 16\n";
 +
 +eval {
 +      sigaction(SIGHUP, bless({},'Class'), $oldaction);
 +};
 +print $@ ? "ok 17\n" : "not ok 17\n";
 +
 +if ($^O eq 'VMS') {
 +    print "ok 18 # Skip: SIGCONT not trappable in $^O\n";
 +} else {
 +    $newaction=POSIX::SigAction->new(sub { $ok10=1; });
 +    if (eval { SIGCONT; 1 }) {
 +      sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
 +      {
 +          local($^W)=0;
 +          kill 'CONT', $$;
 +      }
 +    }
 +    print $bad18 ? "not ok 18\n" : "ok 18\n";
 +}
 +
index 0000000,e6a91d1..8415816
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,265 +1,263 @@@
 -my $fname = $0;
 -$fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also
 -is( $fake_out, "<!-- warning: There is a problem at $fname line 95. -->\n",
+ # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
+ #!/usr/local/bin/perl -w
+ use strict;
+ use lib qw(t/lib);
+ use Test::More tests => 42;
+ use IO::Handle;
+ BEGIN { use_ok('CGI::Carp') };
+ #-----------------------------------------------------------------------------
+ # Test id
+ #-----------------------------------------------------------------------------
+ # directly invoked
+ my $expect_f = __FILE__;
+ my $expect_l = __LINE__ + 1;
+ my ($file, $line, $id) = CGI::Carp::id(0);
+ is($file, $expect_f, "file");
+ is($line, $expect_l, "line");
+ is($id, "carp.t", "id");
+ # one level of indirection
+ sub id1 { my $level = shift; return CGI::Carp::id($level); };
+ $expect_l = __LINE__ + 1;
+ ($file, $line, $id) = id1(1);
+ is($file, $expect_f, "file");
+ is($line, $expect_l, "line");
+ is($id, "carp.t", "id");
+ # two levels of indirection
+ sub id2 { my $level = shift; return id1($level); };
+ $expect_l = __LINE__ + 1;
+ ($file, $line, $id) = id2(2);
+ is($file, $expect_f, "file");
+ is($line, $expect_l, "line");
+ is($id, "carp.t", "id");
+ #-----------------------------------------------------------------------------
+ # Test stamp
+ #-----------------------------------------------------------------------------
+ my $stamp = "/^\\[
+       ([a-z]{3}\\s){2}\\s?
+       [\\s\\d:]+
+       \\]\\s$id:/ix";
+ like(CGI::Carp::stamp(),
+      $stamp,
+      "Time in correct format");
+ sub stamp1 {return CGI::Carp::stamp()};
+ sub stamp2 {return stamp1()};
+ like(stamp2(), $stamp, "Time in correct format");
+ #-----------------------------------------------------------------------------
+ # Test warn and _warn
+ #-----------------------------------------------------------------------------
+ # set some variables to control what's going on.
+ $CGI::Carp::WARN = 0;
+ $CGI::Carp::EMIT_WARNINGS = 0;
+ @CGI::Carp::WARNINGS = ();
+ my $q_file = quotemeta($file);
+ # Test that realwarn is called
+ {
+   local $^W = 0;
+   eval "sub CGI::Carp::realwarn {return 'Called realwarn'};";
+ }
+ $expect_l = __LINE__ + 1;
+ is(CGI::Carp::warn("There is a problem"),
+    "Called realwarn",
+    "CGI::Carp::warn calls CORE::warn");
+ is(@CGI::Carp::WARNINGS, 0, "_warn not called");
+ # Test that message is constructed correctly
+ eval 'sub CGI::Carp::realwarn {my $mess = shift; return $mess};';
+ $expect_l = __LINE__ + 1;
+ like(CGI::Carp::warn("There is a problem"),
+    "/] $id: There is a problem at $q_file line $expect_l.".'$/',
+    "CGI::Carp::warn builds correct message");
+ is(@CGI::Carp::WARNINGS, 0, "_warn not called");
+ # Test that _warn is called at the correct time
+ $CGI::Carp::WARN = 1;
+ $expect_l = __LINE__ + 1;
+ like(CGI::Carp::warn("There is a problem"),
+    "/] $id: There is a problem at $q_file line $expect_l.".'$/',
+    "CGI::Carp::warn builds correct message");
+ is(@CGI::Carp::WARNINGS, 1, "_warn now called");
+ like($CGI::Carp::WARNINGS[0],
+    "/There is a problem at $q_file line $expect_l.".'$/',
+    "CGI::Carp::WARNINGS has correct message (without stamp)");
+ #-----------------------------------------------------------------------------
+ # Test ineval
+ #-----------------------------------------------------------------------------
+ ok(!CGI::Carp::ineval, 'ineval returns false when not in eval');
+ eval {ok(CGI::Carp::ineval, 'ineval returns true when in eval');};
+ #-----------------------------------------------------------------------------
+ # Test die
+ #-----------------------------------------------------------------------------
+ # set some variables to control what's going on.
+ $CGI::Carp::WRAP = 0;
+ $expect_l = __LINE__ + 1;
+ eval { CGI::Carp::die('There is a problem'); };
+ like($@,
+      '/^There is a problem/',
+      'CGI::Carp::die calls CORE::die without altering argument in eval');
+ # Test that realwarn is called
+ {
+   local $^W = 0;
+   eval 'sub CGI::Carp::realdie {my $mess = shift; return $mess};';
+ }
+ like(CGI::Carp::die('There is a problem'),
+      $stamp,
+      'CGI::Carp::die calls CORE::die, but adds stamp');
+ #-----------------------------------------------------------------------------
+ # Test set_message
+ #-----------------------------------------------------------------------------
+ is(CGI::Carp::set_message('My new Message'),
+    'My new Message',
+    'CGI::Carp::set_message returns new message');
+ is($CGI::Carp::CUSTOM_MSG,
+    'My new Message',
+    'CGI::Carp::set_message message set correctly');
+ # set the message back to the empty string so that the tests later
+ # work properly.
+ CGI::Carp::set_message(''),
+ #-----------------------------------------------------------------------------
+ # Test warnings_to_browser
+ #-----------------------------------------------------------------------------
+ CGI::Carp::warningsToBrowser(0);
+ is($CGI::Carp::EMIT_WARNINGS, 0, "Warnings turned off");
+ unless( is(@CGI::Carp::WARNINGS, 1, "_warn not called") ) {
+   print join "\n", map "'$_'", @CGI::Carp::WARNINGS;
+ }
+ # turn off STDOUT (prevents spurious warnings to screen
+ tie *STDOUT, 'StoreStuff' or die "Can't tie STDOUT";
+ CGI::Carp::warningsToBrowser(1);
+ my $fake_out = join '', <STDOUT>;
+ untie *STDOUT;
+ open(STDOUT, ">&REAL_STDOUT");
++is( $fake_out, "<!-- warning: There is a problem at $0 line 95. -->\n",
+                         'warningsToBrowser() on' );
+ is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off");
+ is(@CGI::Carp::WARNINGS, 0, "_warn is called");
+ #-----------------------------------------------------------------------------
+ # Test fatals_to_browser
+ #-----------------------------------------------------------------------------
+ package StoreStuff;
+ sub TIEHANDLE {
+   my $class = shift;
+   bless [], $class;
+ }
+ sub PRINT {
+   my $self = shift;
+   push @$self, @_;
+ }
+ sub READLINE {
+   my $self = shift;
+   shift @$self;
+ }
+ package main;
+ tie *STDOUT, "StoreStuff";
+ # do tests
+ my @result;
+ CGI::Carp::fatalsToBrowser();
+ $result[0] .= $_ while (<STDOUT>);
+ CGI::Carp::fatalsToBrowser('Message to the world');
+ $result[1] .= $_ while (<STDOUT>);
+ $ENV{SERVER_ADMIN} = 'foo@bar.com';
+ CGI::Carp::fatalsToBrowser();
+ $result[2] .= $_ while (<STDOUT>);
+ CGI::Carp::set_message('Override the message passed in'),
+ CGI::Carp::fatalsToBrowser('Message to the world');
+ $result[3] .= $_ while (<STDOUT>);
+ CGI::Carp::set_message(''),
+ delete $ENV{SERVER_ADMIN};
+ # now restore STDOUT
+ untie *STDOUT;
+ like($result[0],
+      '/Content-type: text/html/',
+      "Default string has header");
+ ok($result[0] !~ /Message to the world/, "Custom message not in default string");
+ like($result[1],
+     '/Message to the world/',
+     "Custom Message appears in output");
+ ok($result[0] !~ /foo\@bar.com/, "Server Admin does not appear in default message");
+ like($result[2],
+     '/foo@bar.com/',
+     "Server Admin appears in output");
+ like($result[3],
+      '/Message to the world/',
+      "Custom message not in result");
+ like($result[3],
+      '/Override the message passed in/',
+      "Correct message in string");
+ #-----------------------------------------------------------------------------
+ # Test to_filehandle
+ #-----------------------------------------------------------------------------
+ sub buffer {
+   CGI::Carp::to_filehandle (@_);
+ }
+ tie *STORE, "StoreStuff";
+ require FileHandle;
+ my $fh = FileHandle->new;
+ ok( defined buffer(\*STORE),       '\*STORE returns proper filehandle');
+ ok( defined buffer( $fh ),         '$fh returns proper filehandle');
+ ok( defined buffer('::STDOUT'),    'STDIN returns proper filehandle');
+ ok( defined buffer(*main::STDOUT), 'STDIN returns proper filehandle');
+ ok(!defined buffer("WIBBLE"),      '"WIBBLE" doesn\'t returns proper filehandle');
index e4a292b,0000000..3d7e236
mode 100644,000000..100644
--- /dev/null
@@@ -1,417 -1,0 +1,407 @@@
- my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'os2';
 +#!./perl -T
 +
 +
 +my %Expect_File = (); # what we expect for $_ 
 +my %Expect_Name = (); # what we expect for $File::Find::name/fullname
 +my %Expect_Dir  = (); # what we expect for $File::Find::dir
 +my $symlink_exists = eval { symlink("",""); 1 };
 +my $cwd;
 +my $cwd_untainted;
 +
 +use Config;
 +
 +BEGIN {
 +    chdir 't' if -d 't';
 +    unshift @INC => '../lib';
 +
 +    for (keys %ENV) { # untaint ENV
 +      ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
 +    }
 +
 +    # Remove insecure directories from PATH
 +    my @path;
 +    my $sep = $Config{path_sep};
 +    foreach my $dir (split(/\Q$sep/,$ENV{'PATH'}))
 +    {
 +      ##
 +      ## Match the directory taint tests in mg.c::Perl_magic_setenv()
 +      ##
 +      push(@path,$dir) unless (length($dir) >= 256
 +                               or
 +                               substr($dir,0,1) ne "/"
 +                               or
 +                               (stat $dir)[2] & 002);
 +    }
 +    $ENV{'PATH'} = join($sep,@path);
 +}
 +
 +
 +if ( $symlink_exists ) { print "1..45\n"; }
 +else                   { print "1..27\n";  }
 +
 +use File::Find;
 +use File::Spec;
 +use Cwd;
 +
 +
- if ($NonTaintedCwd) {
-       Skip("$^O does not taint cwd");
-     } 
- else {
-       Check( $@ =~ m|insecure cwd| );
- }
 +cleanup();
 +
 +find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; },
 +      untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
 +
 +finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; },
 +           untaint => 1, untaint_pattern => qr|^(.+)$|},
 +           File::Spec->curdir);
 +
 +my $case = 2;
 +my $FastFileTests_OK = 0;
 +
 +sub cleanup {
 +    if (-d dir_path('for_find')) {
 +        chdir(dir_path('for_find'));
 +    }
 +    if (-d dir_path('fa')) {
 +        unlink file_path('fa', 'fa_ord'),
 +               file_path('fa', 'fsl'),
 +               file_path('fa', 'faa', 'faa_ord'),
 +               file_path('fa', 'fab', 'fab_ord'),
 +               file_path('fa', 'fab', 'faba', 'faba_ord'),
 +               file_path('fb', 'fb_ord'),
 +               file_path('fb', 'fba', 'fba_ord');
 +        rmdir dir_path('fa', 'faa');
 +        rmdir dir_path('fa', 'fab', 'faba');
 +        rmdir dir_path('fa', 'fab');
 +        rmdir dir_path('fa');
 +        rmdir dir_path('fb', 'fba');
 +        rmdir dir_path('fb');
 +        chdir File::Spec->updir;
 +        rmdir dir_path('for_find');
 +    }
 +}
 +
 +END {
 +    cleanup();
 +}
 +
 +sub Check($) {
 +    $case++;
 +    if ($_[0]) { print "ok $case\n"; }
 +    else       { print "not ok $case\n"; }
 +
 +}
 +
 +sub CheckDie($) {
 +    $case++;
 +    if ($_[0]) { print "ok $case\n"; }
 +    else       { print "not ok $case\n"; exit 0; }
 +}
 +
 +sub Skip($) {
 +    $case++;
 +    print "ok $case # skipped: ",$_[0],"\n"; 
 +}
 +
 +sub touch {
 +    CheckDie( open(my $T,'>',$_[0]) );
 +}
 +
 +sub MkDir($$) {
 +    CheckDie( mkdir($_[0],$_[1]) );
 +}
 +
 +sub wanted_File_Dir {
 +    print "# \$File::Find::dir => '$File::Find::dir'\n";
 +    print "# \$_ => '$_'\n";
 +    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
 +    Check( $Expect_File{$_} );
 +    if ( $FastFileTests_OK ) {
 +        delete $Expect_File{ $_} 
 +          unless ( $Expect_Dir{$_} && ! -d _ );
 +    } else {
 +        delete $Expect_File{$_} 
 +          unless ( $Expect_Dir{$_} && ! -d $_ );
 +    }
 +}
 +
 +sub wanted_File_Dir_prune {
 +    &wanted_File_Dir;
 +    $File::Find::prune=1 if  $_ eq 'faba';
 +}
 +
 +
 +sub simple_wanted {
 +    print "# \$File::Find::dir => '$File::Find::dir'\n";
 +    print "# \$_ => '$_'\n";
 +}
 +
 +
 +# Use dir_path() to specify a directory path that's expected for
 +# $File::Find::dir (%Expect_Dir). Also use it in file operations like
 +# chdir, rmdir etc.
 +#
 +# dir_path() concatenates directory names to form a _relative_
 +# directory path, independant from the platform it's run on, although
 +# there are limitations.  Don't try to create an absolute path,
 +# because that may fail on operating systems that have the concept of
 +# volume names (e.g. Mac OS). Be careful when you want to create an
 +# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
 +# names will work best. As a special case, you can pass it a "." as
 +# first argument, to create a directory path like "./fa/dir" on
 +# operating systems other than Mac OS (actually, Mac OS will ignore
 +# the ".", if it's the first argument). If there's no second argument,
 +# this function will return the empty string on Mac OS and the string
 +# "./" otherwise.
 +
 +sub dir_path {
 +    my $first_item = shift @_;
 +
 +    if ($first_item eq '.') {
 +        if ($^O eq 'MacOS') {
 +            return '' unless @_;
 +            # ignore first argument; return a relative path
 +            # with leading ":" and with trailing ":"
 +            return File::Spec->catdir("", @_); 
 +        } else { # other OS
 +            return './' unless @_;
 +            my $path = File::Spec->catdir(@_);
 +            # add leading "./"
 +            $path = "./$path";
 +            return $path;
 +        }
 +
 +    } else { # $first_item ne '.'
 +        return $first_item unless @_; # return plain filename
 +        if ($^O eq 'MacOS') {
 +            # relative path with leading ":" and with trailing ":"
 +            return File::Spec->catdir("", $first_item, @_);
 +        } else { # other OS
 +            return File::Spec->catdir($first_item, @_);
 +        }
 +    }
 +}
 +
 +
 +# Use topdir() to specify a directory path that you want to pass to
 +#find/finddepth Basically, topdir() does the same as dir_path() (see
 +#above), except that there's no trailing ":" on Mac OS.
 +
 +sub topdir {
 +    my $path = dir_path(@_);
 +    $path =~ s/:$// if ($^O eq 'MacOS');
 +    return $path;
 +}
 +
 +
 +# Use file_path() to specify a file path that's expected for $_ (%Expect_File).
 +# Also suitable for file operations like unlink etc.
 +
 +# file_path() concatenates directory names (if any) and a filename to
 +# form a _relative_ file path (the last argument is assumed to be a
 +# file). It's independant from the platform it's run on, although
 +# there are limitations (see the warnings for dir_path() above). As a
 +# special case, you can pass it a "." as first argument, to create a
 +# file path like "./fa/file" on operating systems other than Mac OS
 +# (actually, Mac OS will ignore the ".", if it's the first
 +# argument). If there's no second argument, this function will return
 +# the empty string on Mac OS and the string "./" otherwise.
 +
 +sub file_path {
 +    my $first_item = shift @_;
 +
 +    if ($first_item eq '.') {
 +        if ($^O eq 'MacOS') {
 +            return '' unless @_;
 +            # ignore first argument; return a relative path  
 +            # with leading ":", but without trailing ":"
 +            return File::Spec->catfile("", @_); 
 +        } else { # other OS
 +            return './' unless @_;
 +            my $path = File::Spec->catfile(@_);
 +            # add leading "./" 
 +            $path = "./$path"; 
 +            return $path;
 +        }
 +
 +    } else { # $first_item ne '.'
 +        return $first_item unless @_; # return plain filename
 +        if ($^O eq 'MacOS') {
 +            # relative path with leading ":", but without trailing ":"
 +            return File::Spec->catfile("", $first_item, @_);
 +        } else { # other OS
 +            return File::Spec->catfile($first_item, @_);
 +        }
 +    }
 +}
 +
 +
 +# Use file_path_name() to specify a file path that's expected for
 +# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
 +# option is in effect, $_ is the same as $File::Find::Name. In that
 +# case, also use this function to specify a file path that's expected
 +# for $_.
 +#
 +# Basically, file_path_name() does the same as file_path() (see
 +# above), except that there's always a leading ":" on Mac OS, even for
 +# plain file/directory names.
 +
 +sub file_path_name {
 +    my $path = file_path(@_);
 +    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
 +    return $path;
 +}
 +
 +
 +
 +MkDir( dir_path('for_find'), 0770 );
 +CheckDie(chdir( dir_path('for_find')));
 +
 +$cwd = cwd(); # save cwd
 +( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
 +
 +MkDir( dir_path('fa'), 0770 );
 +MkDir( dir_path('fb'), 0770  );
 +touch( file_path('fb', 'fb_ord') );
 +MkDir( dir_path('fb', 'fba'), 0770  );
 +touch( file_path('fb', 'fba', 'fba_ord') );
 +if ($^O eq 'MacOS') {
 +      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
 +} else {
 +      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
 +}
 +touch( file_path('fa', 'fa_ord') );
 +
 +MkDir( dir_path('fa', 'faa'), 0770  );
 +touch( file_path('fa', 'faa', 'faa_ord') );
 +MkDir( dir_path('fa', 'fab'), 0770  );
 +touch( file_path('fa', 'fab', 'fab_ord') );
 +MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
 +touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
 +
 +print "# check untainting (no follow)\n";
 +
 +# untainting here should work correctly
 +
 +%Expect_File = (File::Spec->curdir => 1, file_path('fsl') =>
 +                1,file_path('fa_ord') => 1, file_path('fab') => 1,
 +                file_path('fab_ord') => 1, file_path('faba') => 1,
 +                file_path('faa') => 1, file_path('faa_ord') => 1);
 +delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
 +%Expect_Name = ();
 +
 +%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
 +                dir_path('fab') => 1, dir_path('faba') => 1,
 +                dir_path('fb') => 1, dir_path('fba') => 1);
 +
 +delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
 +
 +File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
 +                 untaint_pattern => qr|^(.+)$|}, topdir('fa') );
 +
 +Check( scalar(keys %Expect_File) == 0 );
 +
 +
 +# don't untaint at all, should die
 +%Expect_File = ();
 +%Expect_Name = ();
 +%Expect_Dir  = ();
 +undef $@;
 +eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );};
 +Check( $@ =~ m|Insecure dependency| );
 +chdir($cwd_untainted);
 +
 +
 +# untaint pattern doesn't match, should die 
 +undef $@;
 +
 +eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
 +                         untaint_pattern => qr|^(NO_MATCH)$|},
 +                         topdir('fa') );};
 +
 +Check( $@ =~ m|is still tainted| );
 +chdir($cwd_untainted);
 +
 +
 +# untaint pattern doesn't match, should die when we chdir to cwd   
 +print "# check untaint_skip (No follow)\n";
 +undef $@;
 +
 +eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
 +                         untaint_skip => 1, untaint_pattern =>
 +                         qr|^(NO_MATCH)$|}, topdir('fa') );};
 +
 +print "# $@" if $@;
 +#$^D = 8;
-     if ($NonTaintedCwd) {
-       Skip("$^O does not taint cwd");
-     } 
-     else {
-       Check( $@ =~ m|insecure cwd| );
-     }
++Check( $@ =~ m|insecure cwd| );
++
 +chdir($cwd_untainted);
 +
 +
 +if ( $symlink_exists ) {
 +    print "# --- symbolic link tests --- \n";
 +    $FastFileTests_OK= 1;
 +
 +    print "# check untainting (follow)\n";
 +
 +    # untainting here should work correctly
 +    # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
 +
 +    %Expect_File = (file_path_name('fa') => 1,
 +                  file_path_name('fa','fa_ord') => 1,
 +                  file_path_name('fa', 'fsl') => 1,
 +                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
 +                    file_path_name('fa', 'fsl', 'fba') => 1,
 +                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
 +                    file_path_name('fa', 'fab') => 1,
 +                    file_path_name('fa', 'fab', 'fab_ord') => 1,
 +                    file_path_name('fa', 'fab', 'faba') => 1,
 +                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
 +                    file_path_name('fa', 'faa') => 1,
 +                    file_path_name('fa', 'faa', 'faa_ord') => 1);
 +
 +    %Expect_Name = ();
 +
 +    %Expect_Dir = (dir_path('fa') => 1,
 +                 dir_path('fa', 'faa') => 1,
 +                   dir_path('fa', 'fab') => 1,
 +                 dir_path('fa', 'fab', 'faba') => 1,
 +                 dir_path('fb') => 1,
 +                 dir_path('fb', 'fba') => 1);
 +
 +    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
 +                       no_chdir => 1, untaint => 1, untaint_pattern =>
 +                       qr|^(.+)$| }, topdir('fa') );
 +
 +    Check( scalar(keys %Expect_File) == 0 );
 + 
 +    
 +    # don't untaint at all, should die
 +    undef $@;
 +
 +    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1},
 +                          topdir('fa') );};
 +
 +    Check( $@ =~ m|Insecure dependency| );
 +    chdir($cwd_untainted);
 +
 +    # untaint pattern doesn't match, should die
 +    undef $@;
 +
 +    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
 +                             untaint => 1, untaint_pattern =>
 +                             qr|^(NO_MATCH)$|}, topdir('fa') );};
 +
 +    Check( $@ =~ m|is still tainted| );
 +    chdir($cwd_untainted);
 +
 +    # untaint pattern doesn't match, should die when we chdir to cwd
 +    print "# check untaint_skip (Follow)\n";
 +    undef $@;
 +
 +    eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
 +                             untaint_skip => 1, untaint_pattern =>
 +                             qr|^(NO_MATCH)$|}, topdir('fa') );};
++    Check( $@ =~ m|insecure cwd| );
++
 +    chdir($cwd_untainted);
 +} 
 +
diff --cc t/op/crypt.t
index 0000000,2619338..26eb06a
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,20 +1,15 @@@
 -use Config;
+ use Test::More tests => 2;
 -SKIP: {
 -    skip "crypt unimplemented", 2, unless $Config{d_crypt};
 -    
 -    ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt");
+ # Can't assume too much about the string returned by crypt(),
+ # and about how many bytes of the encrypted (really, hashed)
+ # string matter.
+ #
+ # HISTORICALLY the results started with the first two bytes of the salt,
+ # followed by 11 bytes from the set [./0-9A-Za-z], and only the first
+ # eight characters mattered, but those are probably no more safe
+ # bets, given alternative encryption/hashing schemes like MD5,
+ # C2 (or higher) security schemes, and non-UNIX platforms.
 -    ok(crypt("HI", "HO") eq crypt(v4040.4041, "HO"), "Unicode");
 -}
++ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt");
++ok(crypt("HI", "HO") eq crypt(v4040.4041, "HO"), "Unicode");
index cc2b26a,499049a..499049a
mode 100755,100644..100755