From fbb0b3b383a878902acf90a09bf05a52493ef56c Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Mon, 9 Feb 2004 21:48:15 +0000 Subject: [PATCH] Implement stacked filetest operators (-f -w -x $file). p4raw-id: //depot/perl@22294 --- doio.c | 10 ++++- dump.c | 8 ++-- ext/B/B/Concise.pm | 6 +++ op.c | 3 ++ op.h | 1 + pod/perl591delta.pod | 6 +++ pod/perlfunc.pod | 6 +++ pp_sys.c | 108 ++++++++++++++++++++++++++++++++++++++++----------- t/op/filetest.t | 82 ++++++++++++++++++++------------------ 9 files changed, 166 insertions(+), 64 deletions(-) diff --git a/doio.c b/doio.c index dc192d4..f0b036a 100644 --- a/doio.c +++ b/doio.c @@ -1336,6 +1336,9 @@ Perl_my_stat(pTHX) return (PL_laststatval = -1); } } + else if (PL_op->op_private & OPpFT_STACKED) { + return PL_laststatval; + } else { SV* sv = POPs; char *s; @@ -1362,6 +1365,8 @@ Perl_my_stat(pTHX) } } +static char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; + I32 Perl_my_lstat(pTHX) { @@ -1372,7 +1377,7 @@ Perl_my_lstat(pTHX) EXTEND(SP,1); if (cGVOP_gv == PL_defgv) { if (PL_laststype != OP_LSTAT) - Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat"); + Perl_croak(aTHX_ no_prev_lstat); return PL_laststatval; } if (ckWARN(WARN_IO)) { @@ -1381,6 +1386,9 @@ Perl_my_lstat(pTHX) return (PL_laststatval = -1); } } + else if (ckWARN(WARN_IO) && PL_laststype != OP_LSTAT + && (PL_op->op_private & OPpFT_STACKED)) + Perl_croak(aTHX_ no_prev_lstat); PL_laststype = OP_LSTAT; PL_statgv = Nullgv; diff --git a/dump.c b/dump.c index 75124c6..5f56689 100644 --- a/dump.c +++ b/dump.c @@ -624,9 +624,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) if (o->op_private & OPpHUSH_VMSISH) sv_catpv(tmpsv, ",HUSH_VMSISH"); } - else if (OP_IS_FILETEST_ACCESS(o)) { - if (o->op_private & OPpFT_ACCESS) - sv_catpv(tmpsv, ",FT_ACCESS"); + else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) { + if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS) + sv_catpv(tmpsv, ",FT_ACCESS"); + if (o->op_private & OPpFT_STACKED) + sv_catpv(tmpsv, ",FT_STACKED"); } if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) sv_catpv(tmpsv, ",INTRO"); diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 7aadd0b..2b8a612 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -423,6 +423,12 @@ $priv{"threadsv"}{64} = "SVREFd"; $priv{"exit"}{128} = "VMS"; $priv{$_}{2} = "FTACCESS" for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec"); +$priv{$_}{4} = "FTSTACKED" + for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec", + "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime", + "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir", + "ftpipe", "ftlink", "ftsuid", "ftsgid", "ftsvtx", "fttty", "fttext", + "ftbinary"); $priv{$_}{2} = "GREPLEX" for ("mapwhile", "mapstart", "grepwhile", "grepstart"); diff --git a/op.c b/op.c index 83c6fc1..e45b664 100644 --- a/op.c +++ b/op.c @@ -5058,6 +5058,9 @@ Perl_ck_ftst(pTHX_ OP *o) OP_IS_FILETEST_ACCESS(o)) o->op_private |= OPpFT_ACCESS; } + if (PL_check[kid->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst) + && kid->op_type != OP_STAT && kid->op_type != OP_LSTAT) + o->op_private |= OPpFT_STACKED; } else { op_free(o); diff --git a/op.h b/op.h index aeaae1c..e957e1b 100644 --- a/op.h +++ b/op.h @@ -209,6 +209,7 @@ Deprecated. Use C instead. /* Private of OP_FTXXX */ #define OPpFT_ACCESS 2 /* use filetest 'access' */ +#define OPpFT_STACKED 4 /* stacked filetest, as in "-f -x $f" */ #define OP_IS_FILETEST_ACCESS(op) \ (((op)->op_type) == OP_FTRREAD || \ ((op)->op_type) == OP_FTRWRITE || \ diff --git a/pod/perl591delta.pod b/pod/perl591delta.pod index bf26c2b..564db34 100644 --- a/pod/perl591delta.pod +++ b/pod/perl591delta.pod @@ -57,6 +57,12 @@ L has been improved, and miscellaneous bugs fixed. Now applying C<:unique> to lexical variables and to subroutines will result in a compilation error. +=head2 Stacked filetest operators + +As a new form of syntactic sugar, it's now possible to stack up filetest +operators. You can now write C<-f -w -x $file> in a row to mean +C<-x $file && -w _ && -f _>. See L. + =head1 Modules and Pragmata =over 4 diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 13cfdab..a0ae4b1 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -366,6 +366,12 @@ Example: print "Text\n" if -T _; print "Binary\n" if -B _; +As of Perl 5.9.1, as a form of purely syntactic sugar, you can stack file +test operators, in a way that C<-f -w -x $file> is equivalent to +C<-x $file && -w _ && -f _>. (This is only syntax fancy : if you use +the return value of C<-f $file> as an argument to another filetest +operator, no special magic will happen.) + =item abs VALUE =item abs diff --git a/pp_sys.c b/pp_sys.c index 3de073d..d6f095b 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2877,13 +2877,23 @@ PP(pp_stat) RETURN; } +/* This macro is used by the stacked filetest operators : + * if the previous filetest failed, short-circuit and pass its value. + * Else, discard it from the stack and continue. --rgs + */ +#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \ + if (TOPs == &PL_sv_no || TOPs == &PL_sv_undef) { RETURN; } \ + else { (void)POPs; PUTBACK; } \ + } + PP(pp_ftrread) { I32 result; dSP; + STACKED_FTEST_CHECK; #if defined(HAS_ACCESS) && defined(R_OK) - STRLEN n_a; if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { + STRLEN n_a; result = access(POPpx, R_OK); if (result == 0) RETPUSHYES; @@ -2908,9 +2918,10 @@ PP(pp_ftrwrite) { I32 result; dSP; + STACKED_FTEST_CHECK; #if defined(HAS_ACCESS) && defined(W_OK) - STRLEN n_a; if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { + STRLEN n_a; result = access(POPpx, W_OK); if (result == 0) RETPUSHYES; @@ -2935,9 +2946,10 @@ PP(pp_ftrexec) { I32 result; dSP; + STACKED_FTEST_CHECK; #if defined(HAS_ACCESS) && defined(X_OK) - STRLEN n_a; if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { + STRLEN n_a; result = access(POPpx, X_OK); if (result == 0) RETPUSHYES; @@ -2962,9 +2974,10 @@ PP(pp_fteread) { I32 result; dSP; + STACKED_FTEST_CHECK; #ifdef PERL_EFF_ACCESS_R_OK - STRLEN n_a; if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { + STRLEN n_a; result = PERL_EFF_ACCESS_R_OK(POPpx); if (result == 0) RETPUSHYES; @@ -2989,9 +3002,10 @@ PP(pp_ftewrite) { I32 result; dSP; + STACKED_FTEST_CHECK; #ifdef PERL_EFF_ACCESS_W_OK - STRLEN n_a; if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { + STRLEN n_a; result = PERL_EFF_ACCESS_W_OK(POPpx); if (result == 0) RETPUSHYES; @@ -3016,9 +3030,10 @@ PP(pp_fteexec) { I32 result; dSP; + STACKED_FTEST_CHECK; #ifdef PERL_EFF_ACCESS_X_OK - STRLEN n_a; if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { + STRLEN n_a; result = PERL_EFF_ACCESS_X_OK(POPpx); if (result == 0) RETPUSHYES; @@ -3041,8 +3056,11 @@ PP(pp_fteexec) PP(pp_ftis) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; RETPUSHYES; @@ -3055,8 +3073,11 @@ PP(pp_fteowned) PP(pp_ftrowned) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? @@ -3067,8 +3088,11 @@ PP(pp_ftrowned) PP(pp_ftzero) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (PL_statcache.st_size == 0) @@ -3078,8 +3102,11 @@ PP(pp_ftzero) PP(pp_ftsize) { - I32 result = my_stat(); + I32 result; dSP; dTARGET; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; #if Off_t_size > IVSIZE @@ -3092,8 +3119,11 @@ PP(pp_ftsize) PP(pp_ftmtime) { - I32 result = my_stat(); + I32 result; dSP; dTARGET; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 ); @@ -3102,8 +3132,11 @@ PP(pp_ftmtime) PP(pp_ftatime) { - I32 result = my_stat(); + I32 result; dSP; dTARGET; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 ); @@ -3112,8 +3145,11 @@ PP(pp_ftatime) PP(pp_ftctime) { - I32 result = my_stat(); + I32 result; dSP; dTARGET; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 ); @@ -3122,8 +3158,11 @@ PP(pp_ftctime) PP(pp_ftsock) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (S_ISSOCK(PL_statcache.st_mode)) @@ -3133,8 +3172,11 @@ PP(pp_ftsock) PP(pp_ftchr) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (S_ISCHR(PL_statcache.st_mode)) @@ -3144,8 +3186,11 @@ PP(pp_ftchr) PP(pp_ftblk) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (S_ISBLK(PL_statcache.st_mode)) @@ -3155,8 +3200,11 @@ PP(pp_ftblk) PP(pp_ftfile) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (S_ISREG(PL_statcache.st_mode)) @@ -3166,8 +3214,11 @@ PP(pp_ftfile) PP(pp_ftdir) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (S_ISDIR(PL_statcache.st_mode)) @@ -3177,8 +3228,11 @@ PP(pp_ftdir) PP(pp_ftpipe) { - I32 result = my_stat(); + I32 result; dSP; + STACKED_FTEST_CHECK; + result = my_stat(); + SPAGAIN; if (result < 0) RETPUSHUNDEF; if (S_ISFIFO(PL_statcache.st_mode)) @@ -3201,7 +3255,9 @@ PP(pp_ftsuid) { dSP; #ifdef S_ISUID - I32 result = my_stat(); + I32 result; + STACKED_FTEST_CHECK; + result = my_stat(); SPAGAIN; if (result < 0) RETPUSHUNDEF; @@ -3215,7 +3271,9 @@ PP(pp_ftsgid) { dSP; #ifdef S_ISGID - I32 result = my_stat(); + I32 result; + STACKED_FTEST_CHECK; + result = my_stat(); SPAGAIN; if (result < 0) RETPUSHUNDEF; @@ -3229,7 +3287,9 @@ PP(pp_ftsvtx) { dSP; #ifdef S_ISVTX - I32 result = my_stat(); + I32 result; + STACKED_FTEST_CHECK; + result = my_stat(); SPAGAIN; if (result < 0) RETPUSHUNDEF; @@ -3247,6 +3307,8 @@ PP(pp_fttty) char *tmps = Nullch; STRLEN n_a; + STACKED_FTEST_CHECK; + if (PL_op->op_flags & OPf_REF) gv = cGVOP_gv; else if (isGV(TOPs)) @@ -3289,6 +3351,8 @@ PP(pp_fttext) STRLEN n_a; PerlIO *fp; + STACKED_FTEST_CHECK; + if (PL_op->op_flags & OPf_REF) gv = cGVOP_gv; else if (isGV(TOPs)) diff --git a/t/op/filetest.t b/t/op/filetest.t index fcded7a..d0ca69a 100755 --- a/t/op/filetest.t +++ b/t/op/filetest.t @@ -6,25 +6,17 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } use Config; -print "1..10\n"; +plan(tests => 22); -print "not " unless -d 'op'; -print "ok 1\n"; - -print "not " unless -f 'TEST'; -print "ok 2\n"; - -print "not " if -f 'op'; -print "ok 3\n"; - -print "not " if -d 'TEST'; -print "ok 4\n"; - -print "not " unless -r 'TEST'; -print "ok 5\n"; +ok( -d 'op' ); +ok( -f 'TEST' ); +ok( !-f 'op' ); +ok( !-d 'TEST' ); +ok( -r 'TEST' ); # make sure TEST is r-x eval { chmod 0555, 'TEST' }; @@ -35,18 +27,19 @@ eval '$> = 1'; # so switch uid (may not be implemented) print "# oldeuid = $oldeuid, euid = $>\n"; -if (!$Config{d_seteuid}) { - print "ok 6 #skipped, no seteuid\n"; -} -elsif ($Config{config_args} =~/Dmksymlinks/) { - print "ok 6 #skipped, we cannot chmod symlinks\n"; -} -elsif ($bad_chmod) { - print "#[$@]\nok 6 #skipped\n"; -} -else { - print "not " if -w 'TEST'; - print "ok 6\n"; +SKIP: { + if (!$Config{d_seteuid}) { + skip('no seteuid'); + } + elsif ($Config{config_args} =~/Dmksymlinks/) { + skip('we cannot chmod symlinks'); + } + elsif ($bad_chmod) { + skip( $@ ); + } + else { + ok( !-w 'TEST' ); + } } # Scripts are not -x everywhere so cannot test that. @@ -55,20 +48,33 @@ eval '$> = $oldeuid'; # switch uid back (may not be implemented) # this would fail for the euid 1 # (unless we have unpacked the source code as uid 1...) -print "not " unless -r 'op'; -print "ok 7\n"; +ok( -r 'op' ); # this would fail for the euid 1 # (unless we have unpacked the source code as uid 1...) -if ($Config{d_seteuid}) { - print "not " unless -w 'op'; - print "ok 8\n"; -} else { - print "ok 8 #skipped, no seteuid\n"; +SKIP: { + if ($Config{d_seteuid}) { + ok( -w 'op' ); + } else { + skip('no seteuid'); + } } -print "not " unless -x 'op'; # Hohum. Are directories -x everywhere? -print "ok 9\n"; +ok( -x 'op' ); # Hohum. Are directories -x everywhere? + +is( "@{[grep -r, qw(foo io noo op zoo)]}", "io op" ); + +# Test stackability of filetest operators -print "not " unless "@{[grep -r, qw(foo io noo op zoo)]}" eq "io op"; -print "ok 10\n"; +ok( defined( -f -d 'TEST' ) && ! -f -d _ ); +ok( !defined( -e 'zoo' ) ); +ok( !defined( -e -d 'zoo' ) ); +ok( !defined( -f -e 'zoo' ) ); +ok( -f -e 'TEST' ); +ok( -e -f 'TEST' ); +ok( defined(-d -e 'TEST') ); +ok( defined(-e -d 'TEST') ); +ok( ! -f -d 'op' ); +ok( -x -d -x 'op' ); +ok( (-s -f 'TEST' > 1), "-s returns real size" ); +ok( -f -s 'TEST' == 1 ); -- 2.7.4