From 6d28b2f81aed20ff58658d87ea860f0e4cf0ce8a Mon Sep 17 00:00:00 2001 From: Lukas Mai Date: Mon, 1 Jul 2024 11:31:24 +0200 Subject: [PATCH] make chdir() return true/false as its documentation claims Previously it would return integer 1 and 0, not booleans. Fixes #22365. --- ext/POSIX/t/wrappers.t | 2 +- lib/B/Op_private.pm | 4 ++-- opcode.h | 10 +++++----- pp_sys.c | 17 +++++++---------- regen/opcodes | 2 +- t/op/chdir.t | 24 ++++++++++++++++-------- t/op/coreamp.t | 22 ++++++++++++++-------- 7 files changed, 46 insertions(+), 35 deletions(-) diff --git a/ext/POSIX/t/wrappers.t b/ext/POSIX/t/wrappers.t index 76d4a08e98..3683e7a3db 100644 --- a/ext/POSIX/t/wrappers.t +++ b/ext/POSIX/t/wrappers.t @@ -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], diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index aa538c274d..229f4c2442 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -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)], diff --git a/opcode.h b/opcode.h index 698ccf9d8a..6563550932 100644 --- a/opcode.h +++ b/opcode.h @@ -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), diff --git a/pp_sys.c b/pp_sys.c index 9e80569f18..951aea390f 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -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 } diff --git a/regen/opcodes b/regen/opcodes index 56eea56000..bf8e9fdf12 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -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 diff --git a/t/op/chdir.t b/t/op/chdir.t index 44bc90f14d..6e5a941022 100644 --- a/t/op/chdir.t +++ b/t/op/chdir.t @@ -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'); } diff --git a/t/op/coreamp.t b/t/op/coreamp.t index 2744c5f6ad..71649790a3 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -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'; } }