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
--- /dev/null
+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' );
+}