mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

make chdir() return true/false as its documentation claims

Browse Source 
Previously it would return integer 1 and 0, not booleans.

Fixes #22365.
This commit is contained in:
Lukas Mai 2024-07-01 11:31:24 +02:00 committed by mauke
parent 7ea9cde9d9
commit 6d28b2f81a
7 changed files with 46 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ext/POSIX/t/wrappers.t
View File

@ -164,7 +164,7 @@ SKIP: {
is(-e NOT_HERE, undef, NOT_HERE . ' does not exist');
foreach ([undef, 0, 'chdir', NOT_HERE],
foreach ([undef, !!0, 'chdir', NOT_HERE],
[undef, 0, 'chmod', 0, NOT_HERE],
['d_chown', 0, 'chown', 0, 0, NOT_HERE],
[undef, undef, 'creat', NOT_HERE . '/crash', 0],

4
lib/B/Op_private.pm generated
View File

@ -150,7 +150,7 @@ $bits{$_}{6} = 'OPpPAD_STATE' for qw(emptyavhv lvavref lvref padav padhv padsv p
$bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
$bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite);
$bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv);
$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide emptyavhv exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_negate i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement negate oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time undef unlink unshift utime wait waitpid);
$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 ceil chmod chomp chown chr chroot concat cos crypt divide emptyavhv exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_negate i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement negate oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time undef unlink unshift utime wait waitpid);
$bits{$_}{0} = 'OPpTRANS_CAN_FORCE_UTF8' for qw(trans transr);
$bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr);
$bits{$_}{7} = 'OPpTRANS_DELETE' for qw(trans transr);
@ -906,7 +906,7 @@ our %ops_using = (
OPpSORT_DESCEND => [qw(sort)],
OPpSPLIT_ASSIGN => [qw(split)],
OPpSUBSTR_REPL_FIRST => [qw(substr)],
OPpTARGET_MY => [qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide emptyavhv exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_negate i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement negate oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time undef unlink unshift utime wait waitpid)],
OPpTARGET_MY => [qw(abs add atan2 ceil chmod chomp chown chr chroot concat cos crypt divide emptyavhv exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_negate i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement negate oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time undef unlink unshift utime wait waitpid)],
OPpTRANS_CAN_FORCE_UTF8 => [qw(trans transr)],
OPpTRUEBOOL => [qw(blessed grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
OPpUNDEF_KEEP_PV => [qw(undef)],

10
opcode.h generated
View File

@ -2153,7 +2153,7 @@ EXTCONST U32 PL_opargs[] INIT({
0x00006c04, /* fttty */
0x00006c84, /* fttext */
0x00006c84, /* ftbinary */
0x00009b1c, /* chdir */
0x00009b04, /* chdir */
0x0000241d, /* chown */
0x00009b9c, /* chroot */
0x0000249d, /* unlink */
@ -2871,7 +2871,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
222, /* fttty */
222, /* fttext */
222, /* ftbinary */
102, /* chdir */
56, /* chdir */
102, /* chown */
79, /* chroot */
102, /* unlink */
@ -3028,7 +3028,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x3cec, 0x0003, /* av2arylen, akeys, values, keys */
0x3fbc, 0x1198, 0x0ef4, 0x014c, 0x5388, 0x5084, 0x0003, /* rv2cv */
0x06d4, 0x0770, 0x0003, /* ref, blessed */
0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, chdir, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
0x463c, 0x4558, 0x2e74, 0x2db0, 0x0003, /* backtick */
0x06d5, /* subst */
0x129c, 0x2558, 0x0ad4, 0x4eec, 0x28e8, 0x5724, 0x08e1, /* trans, transr */
@ -3041,7 +3041,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x1658, 0x0067, /* repeat */
0x3ed8, 0x5430, 0x0067, /* concat */
0x3bfc, 0x0338, 0x1e34, 0x5430, 0x516c, 0x0003, /* multiconcat */
0x5430, 0x018f, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
0x5430, 0x018f, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
0x5430, 0x5649, /* left_shift, right_shift, nbit_and, nbit_xor, nbit_or, ncomplement */
0x5649, /* bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, complement */
0x06d4, 0x5430, 0x0003, /* length */
@ -3399,7 +3399,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* FTTTY */ (OPpARG1_MASK|OPpFT_STACKED|OPpFT_STACKING|OPpFT_AFTER_t),
/* FTTEXT */ (OPpARG1_MASK|OPpFT_STACKED|OPpFT_STACKING|OPpFT_AFTER_t),
/* FTBINARY */ (OPpARG1_MASK|OPpFT_STACKED|OPpFT_STACKING|OPpFT_AFTER_t),
/* CHDIR */ (OPpARG4_MASK|OPpTARGET_MY),
/* CHDIR */ (OPpARG4_MASK),
/* CHOWN */ (OPpARG4_MASK|OPpTARGET_MY),
/* CHROOT */ (OPpARG1_MASK|OPpTARGET_MY),
/* UNLINK */ (OPpARG4_MASK|OPpTARGET_MY),

17
pp_sys.c
View File

@ -3902,7 +3902,7 @@ PP(pp_fttext)
PP_wrapped(pp_chdir, MAXARG, 0)
{
dSP; dTARGET;
dSP;
const char *tmps = NULL;
GV *gv = NULL;
/* pp_coreargs pushes a NULL to indicate no args passed to
@ -3918,9 +3918,8 @@ PP_wrapped(pp_chdir, MAXARG, 0)
"chdir() on unopened filehandle %" SVf, sv);
}
SETERRNO(EBADF,RMS_IFI);
PUSHs(&PL_sv_zero);
TAINT_PROPER("chdir");
RETURN;
RETPUSHNO;
}
}
else if (!(gv = MAYBE_DEREF_GV(sv)))
@ -3941,10 +3940,9 @@ PP_wrapped(pp_chdir, MAXARG, 0)
tmps = SvPV_nolen_const(*svp);
}
else {
PUSHs(&PL_sv_zero);
SETERRNO(EINVAL, LIB_INVARG);
TAINT_PROPER("chdir");
RETURN;
RETPUSHNO;
}
}
@ -3954,13 +3952,13 @@ PP_wrapped(pp_chdir, MAXARG, 0)
IO* const io = GvIO(gv);
if (io) {
if (IoDIRP(io)) {
PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
PUSHs(boolSV(fchdir(my_dirfd(IoDIRP(io))) >= 0));
} else if (IoIFP(io)) {
int fd = PerlIO_fileno(IoIFP(io));
if (fd < 0) {
goto nuts;
}
PUSHi(fchdir(fd) >= 0);
PUSHs(boolSV(fchdir(fd) >= 0));
}
else {
goto nuts;
@ -3974,7 +3972,7 @@ PP_wrapped(pp_chdir, MAXARG, 0)
#endif
}
else
PUSHi( PerlDir_chdir(tmps) >= 0 );
PUSHs(boolSV( PerlDir_chdir(tmps) >= 0 ));
#ifdef VMS
/* Clear the DEFAULT element of ENV so we'll get the new value
* in the future. */
@ -3986,8 +3984,7 @@ PP_wrapped(pp_chdir, MAXARG, 0)
nuts:
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
PUSHs(&PL_sv_zero);
RETURN;
RETPUSHNO;
#endif
}

2
regen/opcodes
View File

@ -435,7 +435,7 @@ ftbinary -B ck_ftst isu- F-
# File calls.
# chdir really behaves as if it had both "S?" and "F?"
chdir chdir ck_trunc isT% S?
chdir chdir ck_trunc is% S?
chown chown ck_fun imsT@ L
chroot chroot ck_fun isTu% S?
unlink unlink ck_fun imsTu@ L

24
t/op/chdir.t
View File

@ -12,10 +12,11 @@ BEGIN {
set_up_inc(qw(t . lib ../lib));
}
plan(tests => 44);
plan(tests => 2 + 20 + 1 + 1 + 3*8 + 3);
use Config;
use Errno qw(ENOENT EBADF EINVAL);
no warnings qw(experimental::builtin); # is_bool
my $IsVMS = $^O eq 'VMS';
@ -53,7 +54,7 @@ SKIP: {
$Cwd = abs_path;
SKIP: {
skip("no fchdir", 19) unless $has_fchdir;
skip("no fchdir", 20) unless $has_fchdir;
my $has_dirfd = ($Config{d_dirfd} || $Config{d_dir_dd_fd} || "") eq "define";
ok(opendir(my $dh, "."), "opendir .");
ok(open(my $fh, "<", "op"), "open op");
@ -92,7 +93,9 @@ SKIP: {
{
my $warn;
local $SIG{__WARN__} = sub { $warn = shift };
ok(!chdir(H), "check we can't chdir to closed handle");
my $r = chdir(H);
ok(!$r, "check we can't chdir to closed handle");
ok(builtin::is_bool($r), 'chdir returns bool on failure');
is(0+$!, EBADF, 'check $! set appropriately');
like($warn, qr/on closed filehandle H/, 'like closed');
$! = 0;
@ -122,20 +125,25 @@ sub check_env {
# Make sure $ENV{'SYS$LOGIN'} is only honored on VMS.
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 test SYS\$LOGIN on $^O" ) for 1..4;
my $r = chdir();
ok( !$r, "chdir() on $^O ignores only \$ENV{$key} set" );
ok( builtin::is_bool($r), ' and the return value is a bool' );
is( abs_path, $Cwd, ' abs_path() did not change' );
pass( " no need to test SYS\$LOGIN on $^O" ) for 1..5;
}
else {
ok( chdir(), "chdir() w/ only \$ENV{$key} set" );
is( abs_path, $ENV{$key}, ' abs_path() agrees' );
chdir($Cwd);
my $r = chdir($Cwd);
is( abs_path, $Cwd, ' and back again' );
ok( builtin::is_bool($r), ' and the return value is a bool' );
my $warning = '';
local $SIG{__WARN__} = sub { $warning .= join '', @_ };
$! = 0;
ok(!chdir(''), "chdir('') no longer implied chdir()");
$r = chdir('');
ok(!$r, "chdir('') no longer implies chdir()");
ok(builtin::is_bool($r), 'chdir returns bool on failure');
is($!+0, ENOENT, 'check $! set appropriately');
is($warning, '', 'should no longer warn about deprecation');
}

22
t/op/coreamp.t
View File

@ -410,21 +410,27 @@ use if !is_miniperl, File::Spec::Functions, qw(curdir);
test_proto 'chdir';
unless (is_miniperl) {
$tests += 7;
my ($false, $true) = (!!0, !!1);
my $good_dir = curdir();
my $bad_dir = 'no_such_dir+*?~';
is mychdir($good_dir), 1, 'mychdir(".") succeeds';
is mychdir($bad_dir), 0, 'mychdir($bad_dir) fails';
is &CORE::chdir($good_dir), 1, '&chdir(".") succeeds';
is &CORE::chdir($bad_dir), 0, '&chdir($bad_dir) fails';
is mychdir($good_dir), $true, 'mychdir(".") succeeds';
is mychdir($bad_dir), $false, 'mychdir($bad_dir) fails';
is &CORE::chdir($good_dir), $true, '&chdir(".") succeeds';
is &CORE::chdir($bad_dir), $false, '&chdir($bad_dir) fails';
{
local $ENV{HOME} = $good_dir;
is &CORE::chdir(), 1, '&chdir() succeeds with $ENV{HOME} = "."';
is &CORE::chdir(), $true, '&chdir() succeeds with $ENV{HOME} = "."';
$ENV{HOME} = $bad_dir;
is &CORE::chdir(), 0, '&chdir() fails with $ENV{HOME} = $bad_dir';
is &CORE::chdir(), $false, '&chdir() fails with $ENV{HOME} = $bad_dir';
}
{
SKIP: {
# I don't know enough about VMS to tell whether it is possible to
# delete $ENV{'SYS$LOGIN'} and what that would mean, so just be
# cautious and skip this test there until someone can verify.
skip 'not messing with SYS$LOGIN on VMS', 1
if $^O eq 'VMS';
delete local @ENV{qw(HOME LOGDIR SYS$LOGIN)};
is &CORE::chdir(), 0, '&chdir() fails with @ENV{qw(HOME LOGDIR SYS$LOGIN)} unset';
is &CORE::chdir(), $false, '&chdir() fails with @ENV{qw(HOME LOGDIR SYS$LOGIN)} unset';
}
}