Re: fchmod, fchown, fchdir

Message-ID: <lrwtnse7nh.fsf@caliper.activestate.com>

+ Schwern's ok -> like changes

p4raw-id: //depot/perl@25157

2 files changed, 50 insertions, 2 deletions

diff --git a/t/io/fs.t b/t/io/fs.t
index 30423f1d28..f1d5fc453b 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -47,7 +47,7 @@ $needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95());
 my $skip_mode_checks =
     $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
 
-plan tests => 34;
+plan tests => 42;
 
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -166,6 +166,37 @@ SKIP: {
     is($ino, undef, "ino of removed file x should be undef");
 }
 
+SKIP: {
+    skip "no fchmod", 5 unless ($Config{d_fchmod} || "") eq "define";
+    ok(open(my $fh, "<", "a"), "open a");
+    is(chmod(0, $fh), 1, "fchmod");
+    $mode = (stat "a")[2];
+    is($mode & 0777, 0, "perm reset");
+    is(chmod($newmode, "a"), 1, "fchmod");
+    $mode = (stat $fh)[2];
+    is($mode & 0777, $newmode, "perm restored");
+}
+
+SKIP: {
+    skip "no fchown", 1 unless ($Config{d_fchown} || "") eq "define";
+    open(my $fh, "<", "a");
+    is(chown(-1, -1, $fh), 1, "fchown");
+}
+
+SKIP: {
+    skip "has fchmod", 1 if ($Config{d_fchmod} || "") eq "define";
+    open(my $fh, "<", "a");
+    eval { chmod(0777, $fh); };
+    like($@, qr/^The fchmod function is unimplemented at/, "fchmod is unimplemented");
+}
+
+SKIP: {
+    skip "has fchown", 1 if ($Config{d_fchown} || "") eq "define";
+    open(my $fh, "<", "a");
+    eval { chown(0, 0, $fh); };
+    like($@, qr/^The fchown function is unimplemented at/, "fchown is unimplemented");
+}
+
 is(rename('a','b'), 1, "rename a b");
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
diff --git a/t/op/chdir.t b/t/op/chdir.t
index 8929069f00..14024a6f25 100644
--- a/t/op/chdir.t
+++ b/t/op/chdir.t
@@ -9,7 +9,7 @@ BEGIN {
 
 use Config;
 require "test.pl";
-plan(tests => 31);
+plan(tests => 38);
 
 my $IsVMS   = $^O eq 'VMS';
 my $IsMacOS = $^O eq 'MacOS';
@@ -42,6 +42,23 @@ SKIP: {
 
 $Cwd = abs_path;
 
+SKIP: {
+    skip("no fchdir", 6) unless ($Config{d_fchdir} || "") eq "define";
+    ok(opendir(my $dh, "."), "opendir .");
+    ok(open(my $fh, "<", "op"), "open op");
+    ok(chdir($fh), "fchdir op");
+    ok(-f "chdir.t", "verify that we are in op");
+    ok(chdir($dh), "fchdir back");
+    ok(-d "op", "verify that we are back");
+}
+
+SKIP: {
+    skip("has fchdir", 1) if ($Config{d_fchdir} || "") eq "define";
+    opendir(my $dh, "op");
+    eval { chdir($dh); };
+    like($@, qr/^The fchdir function is unimplemented at/, "fchdir is unimplemented");
+}
+
 # The environment variables chdir() pays attention to.
 my @magic_envs = qw(HOME LOGDIR SYS$LOGIN);