(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

diff --git a/dump.c b/dump.c
index f23ac7b..1ec2a60 100644 (file)
--- 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 (file)
--- 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 (file)
--- a/op.h
+++ b/op.h
@@ -166,6 +166,7 @@ Deprecated.  Use C<GIMME_V> 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 (file)
--- 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 (executable)
--- 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 (file)
--- 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<perlfunc/require>.
 
+=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<kill -l> 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<perlref>.
 
-=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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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,