From a27978d3b51a1694fbb3bf9d13a41f0518386f5c Mon Sep 17 00:00:00 2001 From: Abhijit Menon-Sen Date: Fri, 6 Jul 2001 06:56:32 +0530 Subject: [PATCH] (Retracted by #11285.) Subject: Re: [PATCH] mkdir() mode argument is missing initial 0 Message-ID: <20010706012632.A28327@lustre.dyn.wiw.org> p4raw-id: //depot/perl@11166 --- dump.c | 2 ++ op.c | 33 +++++++++++++++++++++++++++++++++ op.h | 1 + opcode.h | 6 +++--- opcode.pl | 6 +++--- pod/perldiag.pod | 27 ++++++++++++--------------- pp.sym | 1 + pp_proto.h | 1 + t/lib/warnings/op | 32 ++++++++++++++++++++++++++++++++ t/lib/warnings/toke | 22 ---------------------- toke.c | 21 +++++++-------------- warnings.pl | 7 +++++-- 12 files changed, 100 insertions(+), 59 deletions(-) diff --git a/dump.c b/dump.c index f23ac7b..1ec2a60 100644 --- a/dump.c +++ b/dump.c @@ -519,6 +519,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) else if (o->op_type == OP_CONST) { if (o->op_private & OPpCONST_BARE) sv_catpv(tmpsv, ",BARE"); + if (o->op_private & OPpCONST_OCTAL) + sv_catpv(tmpsv, ",OCTAL"); if (o->op_private & OPpCONST_STRICT) sv_catpv(tmpsv, ",STRICT"); if (o->op_private & OPpCONST_ARYBASE) diff --git a/op.c b/op.c index 44c4739..92d15da 100644 --- a/op.c +++ b/op.c @@ -6117,6 +6117,39 @@ Perl_ck_null(pTHX_ OP *o) } OP * +Perl_ck_octmode(pTHX_ OP *o) +{ + OP *p; + + if ((ckWARN(WARN_OCTMODE) + /* Add WARN_MKDIR instead of getting rid of WARN_{CHMOD,UMASK}. + Backwards compatibility and consistency are terrible things. + AMS 20010705 */ + || (o->op_type == OP_CHMOD && ckWARN(WARN_CHMOD)) + || (o->op_type == OP_UMASK && ckWARN(WARN_UMASK)) + || (o->op_type == OP_MKDIR && ckWARN(WARN_MKDIR))) + && o->op_flags & OPf_KIDS) + { + if (o->op_type == OP_MKDIR) + p = cLISTOPo->op_last; /* mkdir $foo, 0777 */ + else if (o->op_type == OP_CHMOD) + p = cLISTOPo->op_first->op_sibling; /* chmod 0777, $foo */ + else + p = cUNOPo->op_first; /* umask 0222 */ + + if (p->op_type == OP_CONST && !(p->op_private & OPpCONST_OCTAL)) { + int mode = SvIV(cSVOPx_sv(p)); + + Perl_warner(aTHX_ WARN_OCTMODE, + "Non-octal literal mode (%d) specified", mode); + Perl_warner(aTHX_ WARN_OCTMODE, + "\t(Did you mean 0%d instead?)\n", mode); + } + } + return ck_fun(o); +} + +OP * Perl_ck_open(pTHX_ OP *o) { HV *table = GvHV(PL_hintgv); diff --git a/op.h b/op.h index 497a997..05e4580 100644 --- a/op.h +++ b/op.h @@ -166,6 +166,7 @@ Deprecated. Use C instead. #define OPpTARGET_MY 16 /* Target is PADMY. */ /* Private for OP_CONST */ +#define OPpCONST_OCTAL 4 /* Octal constant. */ #define OPpCONST_STRICT 8 /* bearword subject to strict 'subs' */ #define OPpCONST_ENTERED 16 /* Has been entered as symbol. */ #define OPpCONST_ARYBASE 32 /* Was a $[ translated to constant. */ diff --git a/opcode.h b/opcode.h index 28f1345..fd12e46 100644 --- a/opcode.h +++ b/opcode.h @@ -1289,7 +1289,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_fun), /* close */ MEMBER_TO_FPTR(Perl_ck_fun), /* pipe_op */ MEMBER_TO_FPTR(Perl_ck_fun), /* fileno */ - MEMBER_TO_FPTR(Perl_ck_fun), /* umask */ + MEMBER_TO_FPTR(Perl_ck_octmode), /* umask */ MEMBER_TO_FPTR(Perl_ck_fun), /* binmode */ MEMBER_TO_FPTR(Perl_ck_fun), /* tie */ MEMBER_TO_FPTR(Perl_ck_fun), /* untie */ @@ -1361,13 +1361,13 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_fun), /* chown */ MEMBER_TO_FPTR(Perl_ck_fun), /* chroot */ MEMBER_TO_FPTR(Perl_ck_fun), /* unlink */ - MEMBER_TO_FPTR(Perl_ck_fun), /* chmod */ + MEMBER_TO_FPTR(Perl_ck_octmode), /* chmod */ MEMBER_TO_FPTR(Perl_ck_fun), /* utime */ MEMBER_TO_FPTR(Perl_ck_fun), /* rename */ MEMBER_TO_FPTR(Perl_ck_fun), /* link */ MEMBER_TO_FPTR(Perl_ck_fun), /* symlink */ MEMBER_TO_FPTR(Perl_ck_fun), /* readlink */ - MEMBER_TO_FPTR(Perl_ck_fun), /* mkdir */ + MEMBER_TO_FPTR(Perl_ck_octmode), /* mkdir */ MEMBER_TO_FPTR(Perl_ck_fun), /* rmdir */ MEMBER_TO_FPTR(Perl_ck_fun), /* open_dir */ MEMBER_TO_FPTR(Perl_ck_fun), /* readdir */ diff --git a/opcode.pl b/opcode.pl index 4053671..942d8d2 100755 --- a/opcode.pl +++ b/opcode.pl @@ -674,7 +674,7 @@ close close ck_fun is% F? pipe_op pipe ck_fun is@ F F fileno fileno ck_fun ist% F -umask umask ck_fun ist% S? +umask umask ck_octmode ist% S? binmode binmode ck_fun s@ F S? tie tie ck_fun idms@ R S L @@ -767,13 +767,13 @@ chdir chdir ck_fun isT% S? chown chown ck_fun imsT@ L chroot chroot ck_fun isTu% S? unlink unlink ck_fun imsTu@ L -chmod chmod ck_fun imsT@ L +chmod chmod ck_octmode imsT@ L utime utime ck_fun imsT@ L rename rename ck_fun isT@ S S link link ck_fun isT@ S S symlink symlink ck_fun isT@ S S readlink readlink ck_fun stu% S? -mkdir mkdir ck_fun isT@ S S? +mkdir mkdir ck_octmode isT@ S S? rmdir rmdir ck_fun isTu% S? # Directory calls. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index c2946c4..c754333 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1106,16 +1106,6 @@ and so on) and not for Unicode characters, so Perl behaved as if you meant If you actually want to pack Unicode codepoints, use the C<"U"> format instead. -=item chmod() mode argument is missing initial 0 - -(W chmod) A novice will sometimes say - - chmod 777, $filename - -not realizing that 777 will be interpreted as a decimal number, -equivalent to 01411. Octal constants are introduced with a leading 0 in -Perl, as in C. - =item close() on unopened filehandle %s (W unopened) You tried to close a filehandle that was never opened. @@ -1247,6 +1237,12 @@ it compiled correctly and ran its initialization code correctly. It's traditional to end such a file with a "1;", though any true value would do. See L. +=item (Did you mean 0%d instead?) + +(W octmode) The mode argument to chmod, mkdir, and umask is usually +given in octal (octal constants start with a 0, as in C). Did you really +mean to use a non-octal number? + =item (Did you mean &%s instead?) (W) You probably referred to an imported subroutine &FOO as $FOO or some @@ -2207,6 +2203,12 @@ not know about the field name. The field names are looked up in the not recognized. Say C in your shell to see the valid signal names on your system. +=item Non-octal literal mode (%d) specified + +(W octmode) The mode argument to chmod, mkdir, and umask is usually +given in octal (octal constants start with a 0, as in C). Did you really +mean to use a non-octal number? + =item Not a CODE reference (F) Perl was trying to evaluate a reference to a code value (that is, a @@ -3497,11 +3499,6 @@ certain type. Arrays must be @NAME or C<@{EXPR}>. Hashes must be %NAME or C<%{EXPR}>. No implicit dereferencing is allowed--use the {EXPR} forms as an explicit dereference. See L. -=item umask: argument is missing initial 0 - -(W umask) A umask of 222 is incorrect. It should be 0222, because octal -literals always start with 0 in Perl, as in C. - =item umask not implemented (F) Your machine doesn't implement the umask function and you tried to diff --git a/pp.sym b/pp.sym index 151b7c3..2aa4a92 100644 --- a/pp.sym +++ b/pp.sym @@ -26,6 +26,7 @@ Perl_ck_listiob Perl_ck_match Perl_ck_method Perl_ck_null +Perl_ck_octmode Perl_ck_open Perl_ck_repeat Perl_ck_require diff --git a/pp_proto.h b/pp_proto.h index 86ab4c2..97ba330 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -25,6 +25,7 @@ PERL_CKDEF(Perl_ck_listiob) PERL_CKDEF(Perl_ck_match) PERL_CKDEF(Perl_ck_method) PERL_CKDEF(Perl_ck_null) +PERL_CKDEF(Perl_ck_octmode) PERL_CKDEF(Perl_ck_open) PERL_CKDEF(Perl_ck_repeat) PERL_CKDEF(Perl_ck_require) diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 2f847ad..0079146 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -102,6 +102,11 @@ %s() called too early to check prototype [Perl_peep] fred() ; sub fred ($$) {} + Non-octal literal mode (%d) specified + (Did you mean 0%d instead?) + chmod 777, "foo"; + mkdir "foo", 777; + umask 222; Mandatory Warnings ------------------ @@ -926,3 +931,30 @@ unshift(@x); EXPECT Useless use of push with no values at - line 4. Useless use of unshift with no values at - line 5. +######## +# op.c +use warnings 'chmod' ; +chmod 777; +no warnings 'chmod' ; +chmod 777; +EXPECT +Non-octal literal mode (777) specified at - line 3. + (Did you mean 0777 instead?) +######## +# op.c +use warnings 'umask' ; +umask 222; +no warnings 'umask' ; +umask 222; +EXPECT +Non-octal literal mode (222) specified at - line 3. + (Did you mean 0222 instead?) +######## +# op.c +use warnings 'mkdir' ; +mkdir "", 777; +no warnings 'mkdir' ; +mkdir "", 777; +EXPECT +Non-octal literal mode (777) specified at - line 3. + (Did you mean 0777 instead?) diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 242b005..14b745d 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -46,18 +46,12 @@ toke.c AOK warn(warn_reserved $a = abc; - chmod() mode argument is missing initial 0 - chmod 3; - Possible attempt to separate words with commas @a = qw(a, b, c) ; Possible attempt to put comments in qw() list @a = qw(a b # c) ; - umask: argument is missing initial 0 - umask 3; - %s (...) interpreted as function print ("") printf ("") @@ -262,14 +256,6 @@ EXPECT Unquoted string "abc" may clash with future reserved word at - line 3. ######## # toke.c -use warnings 'chmod' ; -chmod 3; -no warnings 'chmod' ; -chmod 3; -EXPECT -chmod() mode argument is missing initial 0 at - line 3. -######## -# toke.c use warnings 'qw' ; @a = qw(a, b, c) ; no warnings 'qw' ; @@ -286,14 +272,6 @@ EXPECT Possible attempt to put comments in qw() list at - line 3. ######## # toke.c -use warnings 'umask' ; -umask 3; -no warnings 'umask' ; -umask 3; -EXPECT -umask: argument is missing initial 0 at - line 3. -######## -# toke.c use warnings 'syntax' ; print ("") EXPECT diff --git a/toke.c b/toke.c index 3ae0f27..47dacaf 100644 --- a/toke.c +++ b/toke.c @@ -4299,12 +4299,6 @@ Perl_yylex(pTHX) LOP(OP_CRYPT,XTERM); case KEY_chmod: - if (ckWARN(WARN_CHMOD)) { - for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ; - if (*d != '0' && isDIGIT(*d)) - Perl_warner(aTHX_ WARN_CHMOD, - "chmod() mode argument is missing initial 0"); - } LOP(OP_CHMOD,XTERM); case KEY_chown: @@ -5162,12 +5156,6 @@ Perl_yylex(pTHX) LOP(OP_UTIME,XTERM); case KEY_umask: - if (ckWARN(WARN_UMASK)) { - for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ; - if (*d != '0' && isDIGIT(*d)) - Perl_warner(aTHX_ WARN_UMASK, - "umask: argument is missing initial 0"); - } UNI(OP_UMASK); case KEY_unshift: @@ -6914,7 +6902,8 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) register char *e; /* end of temp buffer */ NV nv; /* number read, as a double */ SV *sv = Nullsv; /* place to put the converted number */ - bool floatit; /* boolean: int or float? */ + bool floatit, /* boolean: int or float? */ + octal = 0; /* Is this an octal number? */ char *lastub = 0; /* position of last underbar */ static char number_too_long[] = "Number too long"; @@ -6968,6 +6957,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* so it must be octal */ else { shift = 3; + octal = 1; s++; } @@ -7373,8 +7363,11 @@ vstring: /* make the op for the constant and return */ - if (sv) + if (sv) { lvalp->opval = newSVOP(OP_CONST, 0, sv); + if (octal) + ((SVOP *)lvalp->opval)->op_private |= OPpCONST_OCTAL; + } else lvalp->opval = Nullop; diff --git a/warnings.pl b/warnings.pl index 138b1db..c7b28e9 100644 --- a/warnings.pl +++ b/warnings.pl @@ -37,6 +37,11 @@ my $tree = { 'debugging' => DEFAULT_ON, 'malloc' => DEFAULT_ON, }, + 'octmode' => { + 'chmod' => DEFAULT_OFF, + 'mkdir' => DEFAULT_OFF, + 'umask' => DEFAULT_OFF, + }, 'void' => DEFAULT_OFF, 'recursion' => DEFAULT_OFF, 'redefine' => DEFAULT_OFF, @@ -47,8 +52,6 @@ my $tree = { 'regexp' => DEFAULT_OFF, 'glob' => DEFAULT_OFF, 'y2k' => DEFAULT_OFF, - 'chmod' => DEFAULT_OFF, - 'umask' => DEFAULT_OFF, 'untie' => DEFAULT_OFF, 'substr' => DEFAULT_OFF, 'taint' => DEFAULT_OFF, -- 2.7.4