Double magic/warnings with binmode $fh, undef

From: "Vincent Pit" <perl@profvince.com>
Message-ID: <63615.92.128.97.94.1209490401.squirrel@92.128.97.94>

p4raw-id: //depot/perl@33766

diff --git a/doio.c b/doio.c
index 6b0c9f2..b73f127 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1096,12 +1096,10 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
 }
 
 int
-Perl_mode_from_discipline(pTHX_ SV *discp)
+Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
 {
     int mode = O_BINARY;
-    if (discp) {
-       STRLEN len;
-       const char *s = SvPV_const(discp,len);
+    if (s) {
        while (*s) {
            if (*s == ':') {
                switch (s[1]) {

diff --git a/embed.fnc b/embed.fnc
index 48bddee..43fe830 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -525,7 +525,7 @@ Apd |int    |mg_set         |NN SV* sv
 Ap     |I32    |mg_size        |NN SV* sv
 Ap     |void   |mini_mktime    |NN struct tm *ptm
 EXp    |OP*    |mod            |NULLOK OP* o|I32 type
-p      |int    |mode_from_discipline|NULLOK SV* discp
+p      |int    |mode_from_discipline|NULLOK const char* s|STRLEN len
 Ap     |const char*    |moreswitches   |NN const char* s
 p      |OP*    |my             |NN OP* o
 Ap     |NV     |my_atof        |NN const char *s

diff --git a/embed.h b/embed.h
index ba4899b..6d4e489 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -2801,7 +2801,7 @@
 #define mod(a,b)               Perl_mod(aTHX_ a,b)
 #endif
 #ifdef PERL_CORE
-#define mode_from_discipline(a)        Perl_mode_from_discipline(aTHX_ a)
+#define mode_from_discipline(a,b)      Perl_mode_from_discipline(aTHX_ a,b)
 #endif
 #define moreswitches(a)                Perl_moreswitches(aTHX_ a)
 #ifdef PERL_CORE

diff --git a/op.c b/op.c
index 60c1b77..dc58747 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7415,7 +7415,9 @@ Perl_ck_open(pTHX_ OP *o)
     if (table) {
        SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_IN_RAW;
            else if (mode & O_TEXT)
@@ -7424,7 +7426,9 @@ Perl_ck_open(pTHX_ OP *o)
 
        svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_OUT_RAW;
            else if (mode & O_TEXT)

diff --git a/pp_sys.c b/pp_sys.c
index 59439e9..94549ed 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -762,8 +762,12 @@ PP(pp_binmode)
 
     PUTBACK;
     {
-       const int mode = mode_from_discipline(discp);
-       const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+       STRLEN len = 0;
+       const char *d = NULL;
+       int mode;
+       if (discp)
+           d = SvPV_const(discp, len);
+       mode = mode_from_discipline(d, len);
        if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
            if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
                if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {

diff --git a/proto.h b/proto.h
index cba5fa1..e40cdcf 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1885,7 +1885,7 @@ PERL_CALLCONV void        Perl_mini_mktime(pTHX_ struct tm *ptm)
        assert(ptm)
 
 PERL_CALLCONV OP*      Perl_mod(pTHX_ OP* o, I32 type);
-PERL_CALLCONV int      Perl_mode_from_discipline(pTHX_ SV* discp);
+PERL_CALLCONV int      Perl_mode_from_discipline(pTHX_ const char* s, STRLEN len);
 PERL_CALLCONV const char*      Perl_moreswitches(pTHX_ const char* s)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_MORESWITCHES  \

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 09bd371..ffa69d8 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -1125,7 +1125,6 @@ Use of uninitialized value $m1 in sysopen at - line 16.
 Use of uninitialized value $m1 in umask at - line 19.
 Use of uninitialized value $g1 in umask at - line 20.
 Use of uninitialized value $m1 in binmode at - line 23.
-Use of uninitialized value $m1 in binmode at - line 23.
 ########
 use warnings 'uninitialized';
 my ($m1);