Deprecating chdir(undef)/chdir('')

Message-ID: <20010923000712.A7005@blackrider>

p4raw-id: //depot/perl@12203

4 files changed, 80 insertions, 37 deletions

diff --git a/pod/perl572delta.pod b/pod/perl572delta.pod
index 6b0a6446c8..bfe44c46e9 100644
--- a/pod/perl572delta.pod
+++ b/pod/perl572delta.pod
@@ -100,6 +100,10 @@ deprecated.  Its semantics were never that clear and its
 implementation even less so.  If you have used that feature to
 disallow all but fully qualified variables, C<use strict;> instead.
 
+The chdir(undef) and chdir('') behaviors to match chdir() has been
+deprecated.  In future versions, chdir(undef) and chdir('') will
+simply fail.
+
 =head1 Core Enhancements
 
 In general a lot of fixing has happened in the area of Perl's
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index c0fff95554..7408d2fc1e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3853,6 +3853,16 @@ if you wish to use an empty line as the terminator of the here-document.
 (D deprecated) You are now encouraged to use the shorter *glob{IO} form
 to access the filehandle slot within a typeglob.
 
+=item Use of chdir('') or chdir(undef) as chdir() deprecated
+
+(D deprecated) chdir() with no arguments is documented to change to
+$ENV{HOME} or $ENV{LOGDIR}.  chdir(undef) and chdir('') share this
+behavior, but that has been deprecated.  In future versions they
+will simply fail.
+
+Be careful to check that what you pass to chdir() is defined and not
+blank, else you might find yourself in your home directory.
+
 =item Use of implicit split to @_ is deprecated
 
 (D deprecated) It makes a lot of work for the compiler when you clobber
diff --git a/pp_sys.c b/pp_sys.c
index 40273ce315..0abf357d8b 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3375,23 +3375,28 @@ PP(pp_chdir)
     SV **svp;
     STRLEN n_a;
 
-    if (MAXARG < 1) {
-	if (((svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
-	    || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
+    if( MAXARG == 1 )
+        tmps = POPpx;
+    else
+        tmps = 0;
+
+    if( !tmps || !*tmps ) {
+        if (    (svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
+             || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
 #ifdef VMS
-	    || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
+             || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
 #endif
-	    ) && SvPOK(*svp))
-	{
-	    tmps = SvPV(*svp, n_a);
-	}
-       else {            
+           )
+        {
+            if( MAXARG == 1 )
+                deprecate("chdir('') or chdir(undef) as chdir()");
+            tmps = SvPV(*svp, n_a);
+        }
+        else {            
             PUSHi(0);
             RETURN;
         }
     }
-    else
-	tmps = POPpx;
 
     TAINT_PROPER("chdir");
     PUSHi( PerlDir_chdir(tmps) >= 0 );
diff --git a/t/op/chdir.t b/t/op/chdir.t
index b44cd6f665..23ac735cb6 100644
--- a/t/op/chdir.t
+++ b/t/op/chdir.t
@@ -1,3 +1,5 @@
+#!./perl -w
+
 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
@@ -8,6 +10,8 @@ BEGIN {
 require "test.pl";
 plan(tests => 25);
 
+my $IsVMS = $^O eq 'VMS';
+
 # 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 File::Spec::Functions qw(:DEFAULT splitdir rel2abs);
@@ -18,57 +22,77 @@ sub abs_path {
     rel2abs(curdir);
 }
 
-my $cwd = abs_path;
+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' );
+    is( abs_path, catdir($Cwd, 't'),       '  abs_path() agrees' );
 }
 
-$cwd = abs_path;
+$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';
+sub check_env {
+    my($key) = @_;
 
-    delete @ENV{@magic_envs};
-    local $ENV{$key} = catdir $cwd, 'op';
-    
     # Make sure $ENV{'SYS$LOGIN'} is only honored on VMS.
-    if( $key eq 'SYS$LOGIN' && $^O ne 'VMS' ) {
-        ok( !chdir(),             "chdir() on $^O ignores only \$ENV{$key} set" );
-        is( abs_path, $cwd,       '  abs_path() did not change' );
-        ok( 1,                    "  no need to chdir back on $^O" );
+    if( $key eq 'SYS$LOGIN' && !$IsVMS ) {
+        ok( !chdir(),         "chdir() on $^O ignores only \$ENV{$key} set" );
+        is( abs_path, $Cwd,   '  abs_path() did not change' );
+        pass( "  no need to chdir back on $^O" );
     }
     else {
         ok( chdir(),              "chdir() w/ only \$ENV{$key} set" );
         is( abs_path, $ENV{$key}, '  abs_path() agrees' );
-        chdir($cwd);
-        is( abs_path, $cwd,       '  and back again' );
-    }
+        chdir($Cwd);
+        is( abs_path, $Cwd,       '  and back again' );
+
+        my $warning = '';
+        local $SIG{__WARN__} = sub { $warning .= join '', @_ };
+
 
-    # Bug had chdir(undef) being the same as chdir()
-    ok( !chdir(undef),              "chdir(undef) w/ only \$ENV{$key} set" );
-    is( abs_path, $cwd,             '  abs_path() agrees' );
+        # Check the deprecated chdir(undef) feature.
+#line 60
+        ok( chdir(undef),           "chdir(undef) w/ only \$ENV{$key} set" );
+        is( abs_path, $ENV{$key},   '  abs_path() agrees' );
+        is( $warning,  <<WARNING,   '  got uninit & deprecation warning' );
+Use of uninitialized value in chdir at $0 line 60.
+Use of chdir('') or chdir(undef) as chdir() is deprecated at $0 line 60.
+WARNING
 
-    # Ditto chdir('').
-    ok( !chdir(''),                 "chdir('') w/ only \$ENV{$key} set" );
-    is( abs_path, $cwd,             '  abs_path() agrees' );
+        chdir($Cwd);
+
+        # Ditto chdir('').
+        $warning = '';
+#line 72
+        ok( chdir(''),              "chdir('') w/ only \$ENV{$key} set" );
+        is( abs_path, $ENV{$key},   '  abs_path() agrees' );
+        is( $warning,  <<WARNING,   '  got deprecation warning' );
+Use of chdir('') or chdir(undef) as chdir() is deprecated at $0 line 72.
+WARNING
+
+        chdir($Cwd);
+    }
 }
 
-{
+foreach my $key (@magic_envs) {
     # 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;
+    local %ENV = ();
+    $ENV{$key} = catdir $Cwd, 'op';
+    
+    check_env($key);
+}
+
+{
+    local %ENV = ();
 
     ok( !chdir(),                   'chdir() w/o any ENV set' );
-    is( abs_path, $cwd,             '  abs_path() agrees' );
+    is( abs_path, $Cwd,             '  abs_path() agrees' );
 }