(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

12 files changed, 100 insertions, 59 deletions

diff --git a/dump.c b/dump.c
index f23ac7babc..1ec2a6055a 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 44c473954d..92d15da3a1 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 497a997d19..05e45800af 100644
--- 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 28f1345335..fd12e46afe 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 4053671733..942d8d2f6d 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 c2946c4940..c754333040 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<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 151b7c3983..2aa4a9230c 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 86ab4c2550..97ba330bf2 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 2f847ad14c..0079146ad3 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 242b0059fb..14b745da22 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 3ae0f276e8..47dacaf832 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 138b1db5af..c7b28e976b 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,