In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/f853e70ac6fb4770dfc9ea44704df8480e41b033?hp=98be99db6ff47327a7754b282e66c6be7eb35bb6>

- Log -----------------------------------------------------------------
commit f853e70ac6fb4770dfc9ea44704df8480e41b033
Author: Father Chrysostomos <[email protected]>
Date:   Fri Dec 10 16:12:13 2010 -0800

    perldelta for [perl #68658]

M       pod/perldelta.pod

commit e6f1cc4db50c9cdd01b82e9d85fc4ae74079e64a
Author: Father Chrysostomos <[email protected]>
Date:   Fri Dec 10 14:59:31 2010 -0800

    perldelta for 0e5d25b

M       pod/perldelta.pod

commit 3e2413e5f999573e5bcccfb506d8a449a3ab690b
Author: David Leadbeater <[email protected]>
Date:   Fri Dec 10 14:56:41 2010 -0800

    [perl #80548] Add the stash name to DTrace probes
    
    This adds an additional parameter to perl's dtrace probes with the stash
    name of the subroutine. This generally looks nicer than the filename but
    gives a similar level of context.
    
    As this is an additional parameter this will not have an impact on
    existing DTrace scripts. (Also due to the way DTrace works I believe it
    does not break binary compatibility and would be safe to backport to
    maint-5.12 if desired, but I'm not a DTrace expert.)

M       cop.h
M       mydtrace.h
M       perldtrace.d

commit 6d1f0892ce0bd77f843552ab189aa5f121c374d4
Author: Father Chrysostomos <[email protected]>
Date:   Fri Dec 10 14:54:13 2010 -0800

    [perl #72090] unitialized variable name wrong with no strict refs
    
    $ ./perl -we '$a = @$a > 0'
    Use of uninitialized value $a in array dereference at -e line 1.
    Use of uninitialized value $a in numeric gt (>) at -e line 1.
    
    S_find_uninit_var was not taking into account that rv2*v could return
    undef. So it merrily looked at the child ops to find one that named
    a variable.
    
    This commit makes it skip any rv2av/rv2hv that does not have an OP_GV
    as its child op.
    
    In other words, it skips @{...} and %{...} (including the shorthand
    forms @$foo and %$foo), but not @foo or %foo.

M       sv.c
M       t/lib/warnings/sv
-----------------------------------------------------------------------

Summary of changes:
 cop.h             |    6 ++++--
 mydtrace.h        |   16 ++++++++--------
 perldtrace.d      |    4 ++--
 pod/perldelta.pod |   12 +++++++++++-
 sv.c              |    6 ++++++
 t/lib/warnings/sv |    7 +++++++
 6 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/cop.h b/cop.h
index 0a6169b..939d1ff 100644
--- a/cop.h
+++ b/cop.h
@@ -617,7 +617,8 @@ struct block_format {
 #define PUSHSUB_BASE(cx)                                               \
        ENTRY_PROBE(GvENAME(CvGV(cv)),                                  \
                CopFILE((const COP *)CvSTART(cv)),                      \
-               CopLINE((const COP *)CvSTART(cv)));                     \
+               CopLINE((const COP *)CvSTART(cv)),                      \
+               CopSTASHPV((const COP *)CvSTART(cv)));                  \
                                                                        \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
@@ -667,7 +668,8 @@ struct block_format {
     STMT_START {                                                       \
        RETURN_PROBE(GvENAME(CvGV((const CV*)cx->blk_sub.cv)),          \
                CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),      \
-               CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)));     \
+               CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),      \
+               CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));  \
                                                                        \
        if (CxHASARGS(cx)) {                                            \
            POP_SAVEARRAY();                                            \
diff --git a/mydtrace.h b/mydtrace.h
index daabcfa..75e6918 100644
--- a/mydtrace.h
+++ b/mydtrace.h
@@ -13,21 +13,21 @@
 
 #  include "perldtrace.h"
 
-#  define ENTRY_PROBE(func, file, line)        \
-    if (PERL_SUB_ENTRY_ENABLED()) {            \
-       PERL_SUB_ENTRY(func, file, line);       \
+#  define ENTRY_PROBE(func, file, line, stash)         \
+    if (PERL_SUB_ENTRY_ENABLED()) {                    \
+       PERL_SUB_ENTRY(func, file, line, stash);        \
     }
 
-#  define RETURN_PROBE(func, file, line)       \
-    if (PERL_SUB_RETURN_ENABLED()) {           \
-       PERL_SUB_RETURN(func, file, line);      \
+#  define RETURN_PROBE(func, file, line, stash)        \
+    if (PERL_SUB_RETURN_ENABLED()) {                   \
+       PERL_SUB_RETURN(func, file, line, stash);       \
     }
 
 #else
 
 /* NOPs */
-#  define ENTRY_PROBE(func, file, line)
-#  define RETURN_PROBE(func, file, line)
+#  define ENTRY_PROBE(func, file, line, stash)
+#  define RETURN_PROBE(func, file, line, stash)
 
 #endif
 
diff --git a/perldtrace.d b/perldtrace.d
index c5844ea..5175f24 100644
--- a/perldtrace.d
+++ b/perldtrace.d
@@ -4,8 +4,8 @@
  */
 
 provider perl {
-    probe sub__entry(char *, char *, int);
-    probe sub__return(char *, char *, int);
+    probe sub__entry(char *, char *, int, char *);
+    probe sub__return(char *, char *, int, char *);
 };
 
 /*
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 9507e62..675446e 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1,7 +1,7 @@
 =encoding utf8
 
 =for comment
-This has been completed up to 3aadd5cd, except for:
+This has been completed up to a1fba7e, except for:
 d9a4b459f94297889956ac3adc42707365f274c2
 bf5522a13a381257966e7ed6b731195a873b153e
 9cef83062267e94311e1fd8744396e440642738e
@@ -305,6 +305,10 @@ C<Unicode::UCD> has been upgraded from 0.29 to 0.30.
 
 C<version> has been upgraded from 0.82 to 0.86.
 
+=item *
+
+C<Win32> has been upgraded from 0.039 to 0.040.
+
 =back
 
 =head2 Removed Modules and Pragmata
@@ -596,6 +600,12 @@ Mentioning a read-only lexical variable from the enclosing 
scope in a
 string C<eval> would cause the variable to become writable
 L<[perl #19135]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=19135>.
 
+=item *
+
+C<state> can now be used with attributes. It used to mean the same thing as
+C<my> if attributes were present
+L<[perl #68658]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=68658>.
+
 =back
 
 =head1 Known Problems
diff --git a/sv.c b/sv.c
index c0c2458..2cabf7b 100644
--- a/sv.c
+++ b/sv.c
@@ -14031,6 +14031,12 @@ S_find_uninit_var(pTHX_ const OP *const obase, const 
SV *const uninit_sv,
                if ( (type == OP_CONST && SvOK(cSVOPx_sv(kid)))
                  || (type == OP_NULL  && ! (kid->op_flags & OPf_KIDS))
                  || (type == OP_PUSHMARK)
+                 || (
+                     /* @$a and %$a, but not @a or %a */
+                       (type == OP_RV2AV || type == OP_RV2HV)
+                    && cUNOPx(kid)->op_first
+                    && cUNOPx(kid)->op_first->op_type != OP_GV
+                    )
                )
                continue;
            }
diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv
index dbab90b..e29553a 100644
--- a/t/lib/warnings/sv
+++ b/t/lib/warnings/sv
@@ -209,6 +209,13 @@ Use of uninitialized value $a in join or string at - line 
4.
 Use of uninitialized value $a in concatenation (.) or string at - line 5.
 Use of uninitialized value $a in concatenation (.) or string at - line 6.
 ########
+# [perl #72090]
+use warnings 'uninitialized';
+$a = @$a > 0;
+EXPECT
+Use of uninitialized value $a in array dereference at - line 3.
+Use of uninitialized value in numeric gt (>) at - line 3.
+########
 # sv.c 
 use warnings 'numeric' ;
 sub TIESCALAR{bless[]} ; 

--
Perl5 Master Repository

Reply via email to