This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [BUG?] chdir(undef) == chdir() probably a bug
authorMichael G. Schwern <schwern@pobox.com>
Mon, 17 Sep 2001 07:49:04 +0000 (09:49 +0200)
committerAbhijit Menon-Sen <ams@wiw.org>
Mon, 17 Sep 2001 05:44:50 +0000 (05:44 +0000)
Message-Id: <20010917074904.V1588@blackrider>
(Applied with tweaks to chdir.t and pp_sys.c hunks.)

p4raw-id: //depot/perl@12043

MANIFEST
pp_sys.c
t/op/chdir.t [new file with mode: 0644]

index 1bad4c8..0fafcee 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2038,6 +2038,7 @@ t/op/avhv.t                       See if pseudo-hashes work
 t/op/bless.t                   See if bless works
 t/op/bop.t                     See if bitops work
 t/op/chars.t                   See if character escapes work
+t/op/chdir.t                    See if chdir works
 t/op/chop.t                    See if chop works
 t/op/closure.t                 See if closures work
 t/op/cmp.t                     See if the various string and numeric compare work
index 70b1660..0fb4521 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3375,27 +3375,22 @@ PP(pp_chdir)
     SV **svp;
     STRLEN n_a;
 
-    if (MAXARG < 1)
-       tmps = Nullch;
-    else
-       tmps = POPpx;
-    if (!tmps || !*tmps) {
-       svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
-       if (svp)
-           tmps = SvPV(*svp, n_a);
-    }
-    if (!tmps || !*tmps) {
-       svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
-       if (svp)
-           tmps = SvPV(*svp, n_a);
-    }
+    if (MAXARG < 1) {
+       if (((svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
+           || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
 #ifdef VMS
-    if (!tmps || !*tmps) {
-       svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
-       if (svp)
-           tmps = SvPV(*svp, n_a);
-    }
+           || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
 #endif
+           ) && SvPOK(*svp))
+       {
+           tmps = SvPV(*svp, n_a);
+       }
+       else
+           tmps = Nullch;
+    }
+    else
+       tmps = POPpx;
+
     TAINT_PROPER("chdir");
     PUSHi( PerlDir_chdir(tmps) >= 0 );
 #ifdef VMS
diff --git a/t/op/chdir.t b/t/op/chdir.t
new file mode 100644 (file)
index 0000000..118895d
--- /dev/null
@@ -0,0 +1,68 @@
+BEGIN {
+    # We're not going to chdir() into 't' because we don't know if
+    # chdir() works!  Instead, we'll hedge our bets and put both
+    # possibilities into @INC.
+    @INC = ('lib', '../lib');
+}
+
+
+# Might be a little early in the testing process to start using these,
+# but I can't think of a way to write this test without them.
+use Cwd qw(abs_path cwd);
+use File::Spec::Functions qw(:DEFAULT splitdir);
+
+use Test::More tests => 24;
+
+my $cwd = abs_path;
+
+# Let's get to a known position
+SKIP: {
+    skip("Already in t/", 2) if (splitdir(abs_path))[-1] eq 't';
+
+    ok( chdir('t'),     'chdir("t")');
+    is( abs_path, catdir($cwd, 't'),       '  abs_path() agrees' );
+}
+
+$cwd = abs_path;
+
+# The environment variables chdir() pays attention to.
+my @magic_envs = qw(HOME LOGDIR SYS$LOGIN);
+
+foreach my $key (@magic_envs) {
+    # We're going to be using undefs a lot here.
+    no warnings 'uninitialized';
+
+    delete @ENV{@magic_envs};
+    local $ENV{$key} = catdir $cwd, 'op';
+    
+    if( $key eq 'SYS$LOGIN' && $^O ne 'VMS' ) {
+        # Make sure $ENV{'SYS$LOGIN'} is only honored on VMS.
+        ok( !chdir(),             "chdir() w/\$ENV{$key} set" );
+        is( abs_path, $cwd,       '  abs_path() agrees' );
+    }
+    else {
+        ok( chdir(),              "chdir() w/\$ENV{$key} set" );
+        is( abs_path, $ENV{$key}, '  abs_path() agrees' );
+        chdir($cwd);
+        is( abs_path, $cwd,       '  and back again' );
+    }
+
+    # Bug had chdir(undef) being the same as chdir()
+    ok( !chdir(undef),              "chdir(undef) w/\$ENV{$key} set" );
+    is( abs_path, $cwd,             '  abs_path() agrees' );
+
+    # Ditto chdir('').
+    ok( !chdir(''),                 "chdir('') w/\$ENV{$key} set" );
+    is( abs_path, $cwd,             '  abs_path() agrees' );
+}
+
+{
+    # We're going to be using undefs a lot here.
+    no warnings 'uninitialized';
+
+    # Unset all the environment variables chdir() pay attention to.
+    local @ENV{@magic_envs} = (undef) x @magic_envs;
+
+    ok( !chdir(),                   'chdir() w/o any ENV set' );
+    is( abs_path, $cwd,             '  abs_path() agrees' );
+}