[perl.git] branch blead, updated. v5.15.1-304-g4dc304e

2011-08-15 Thread Father Chrysostomos 
In perl.git, the branch blead has been updated



- Log -
commit 4dc304e02d3569a2fbb0907ff3c68656236a547e
Author: Father Chrysostomos 
Date:   Mon Aug 15 22:30:07 2011 -0700

[perl #97076] Fix mad+threads bareword strict exemption

As reported in the ticket this was broken by:

commit eb796c7f1a47acbd996034731639c1bb76e31a19
Author: Gerard Goossen 
Date:   Tue Aug 9 20:35:06 2011 +0200

Move bareword checking from the peephole optimizer to finalize_optree. 
Fixes [perl #95998]

The bareword checking is moved from the peephole optimizer to 
finalize_optree.
newRANGE needs additional bareword checking because the constants may
be optimized away by 'gen_constant_list'.
The OPpCONST_STRICT flag is removed after giving an error about a
bareword to prevent giving multiple errors about the same bareword.

In some cases, like pipe(foo,bar), the bareword was subject to strict
'subs' even though it was meant to be exempt.

A backtrace revealed that it happened in S_finalize_op when called
recursively from this block:

#if defined(PERL_MAD) && defined(USE_ITHREADS)
{
/* Make sure mad ops are also thread-safe */
MADPROP *mp = o->op_madprop;
while (mp) {
if (mp->mad_type == MAD_OP && mp->mad_vlen) {
OP *prop_op = (OP *) mp->mad_val;
/* We only need "Relocate sv to the pad for thread safety.", 
but this
   easiest way to make sure it traverses everything */
finalize_op(prop_op);
}
mp = mp->mad_next;
}
}
#endif

That comment about only needing to relocate the sv to the pad is
telling.  If that’s the only reason for the recursive call, then
we don’t want that recursive call doing strict checking.  So this
commit simply turns off the strict flag, which should be safe, since
S_no_bareword_allowed does the same thing itself.
---

Summary of changes:
 op.c |2 ++
 1 files changed, 2 insertions(+), 0 deletions(-)

diff --git a/op.c b/op.c
index 92fed2b..ae599ad 100644
--- a/op.c
+++ b/op.c
@@ -1474,6 +1474,8 @@ S_finalize_op(pTHX_ OP* o)
OP *prop_op = (OP *) mp->mad_val;
/* We only need "Relocate sv to the pad for thread safety.", 
but this
   easiest way to make sure it traverses everything */
+   if (prop_op->op_type == OP_CONST)
+   cSVOPx(prop_op)->op_private &= ~OPpCONST_STRICT;
finalize_op(prop_op);
}
mp = mp->mad_next;

--
Perl5 Master Repository

[perl.git] branch blead, updated. v5.15.1-303-gbbc28bf

2011-08-15 Thread Father Chrysostomos 
In perl.git, the branch blead has been updated



- Log -
commit bbc28bfcb28b9d71e008cccad034eca23843d3e0
Author: Father Chrysostomos 
Date:   Mon Aug 15 21:47:33 2011 -0700

perldelta update

M   pod/perldelta.pod

commit 10dcd143ab0245b0656647ba04197dc1239caaea
Author: Father Chrysostomos 
Date:   Mon Aug 15 14:50:54 2011 -0700

Two AUTHORS fixes

• Correct Kankovský
• Add Karthik Rajagopalan

M   AUTHORS
---

Summary of changes:
 AUTHORS   |3 +-
 pod/perldelta.pod |   62 +---
 2 files changed, 60 insertions(+), 5 deletions(-)

diff --git a/AUTHORS b/AUTHORS
index 7cb1ded..3432d08 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -597,6 +597,7 @@ Karl Heuer  
 Karl Simon Berg
 Karl Williamson
 Karsten Sperling   
+Karthik Rajagopalan
 Kaveh Ghazi
 Kay Röpke 
 KAWAI Takanori 
@@ -837,7 +838,7 @@ Paul Rogers 
 Paul Saab  
 Paul Schinder  
 Paul Szabo 
-Pavel Ka¿kovský  
+Pavel Kankovský   
 Pavel Zakouril 
 Pedro Felipe Horrillo Guerra   
 Per Einar Ellefsen 
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 6b68c5a..e4e45dc 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1,5 +1,12 @@
 =encoding utf8
 
+=for comment
+This has been completed up to 8367b6810 except for:
+747627ec455e0765e07733ece1545aa3f728a00a (Steffen Müller)
+dd35fa16610ef2fa0d46f5129e626b99cf350d77 (H. Merijn Brand)
+e64345f82d66a32f6da47acf482e7e6c9282b433 (Steffen Müller)
+f1d35e3443aa8451bf47be80983076fe28626113 (Karthik Rajagopalan)
+
 =head1 NAME
 
 [ this is a template for a new perldelta file. Any text flagged as
@@ -159,6 +166,14 @@ Will now croak if attempt to freeze/thaw DB_File object 
[RT #69985]
 
 =item *
 
+L has been upgraded from version 1.23 to 1.24.
+
+It now supports the %u formatting code.  Previously it was unable to find
+descriptions for messages whose entries in L included that code
+[perl #94988].
+
+=item *
+
 L has been upgraded from version 2.43 to version 2.44
 
 Addressed 'decode_xs n-byte heap-overflow' security bug in Unicode.xs
@@ -247,9 +262,10 @@ file and be sure to link to the appropriate page, e.g. 
L.
 
 XXX Changes which create B files in F go here.
 
-=head3 L
+=head3 L
 
-XXX Description of the purpose of the new file here
+This document is intended to provide a list of experimental features in
+Perl.  It is still a work in progress.
 
 =head2 Changes to Existing Documentation
 
@@ -257,13 +273,15 @@ XXX Changes which significantly change existing files in 
F go here.
 However, any changes to F should go in the L
 section.
 
-=head3 L
+=head3 L
 
 =over 4
 
 =item *
 
-XXX Description of the change here
+The ($;) prototype syntax, which has existed for rather a long time, is now
+documented in L.  It allows a unary function to have the same
+precedence as a list operator.
 
 =back
 
@@ -353,6 +371,11 @@ Tests for .ph files have been removed, as these test have 
been optional since
 
 =back
 
+=head3 L
+
+See the entry for C<< diagnostics >> in L,
+above.
+
 =head1 Configuration and Compilation
 
 XXX Changes to F, F, F, and analogous tools
@@ -531,6 +554,37 @@ non-word characters, but what was happening was that 
Unicode rules were
 used to determine wordness/non-wordness for non-ASCII characters.  This
 is now fixed [perl #95968].
 
+=item *
+
+Infinite loops like C<1 while 1> used to stop C mode from
+working for the rest of the block.t
+
+=item *
+
+The C<\h>, C<\H>, C<\v> and C<\V> regular expression metacharacters used to
+cause a panic error message when attempting to match at the end of the
+string [perl #96354].
+
+=item *
+
+For list assignments like C<($a,$b) = ($b,$a)>, Perl has to make a copy of
+the items on the right-hand side before assignment them to the left.  For
+efficiency's sake, it assigns the values on the right straight to the items
+on the left no variable is mentioned on both sides, as in
+C<($a,$b) = ($c,$d)>.  The logic for determining when it can cheat was
+faulty, in that C<&&> and C<||> on the right-hand side could fool it.  So
+C<($a,$b) = $some_true_value && ($b,$a)> would end up assigning the value
+of C<$b> to both scalars.
+
+=item *
+
+Perl no longer tries to apply lvalue context to the string in
+C<("string", $variable) ||= 1> (which used to be an error).  Since the
+left-hand side of C<||=> is evaluated in scalar context, that's a scalar
+comma operator, which gives all but the last item void context.  There is
+no su

[perl.git] branch blead, updated. v5.15.1-301-g8367b68

2011-08-15 Thread Father Chrysostomos 
In perl.git, the branch blead has been updated



- Log -
commit 8367b68105921d0def67524bf5fc0c65b1e402d4
Author: Father Chrysostomos 
Date:   Mon Aug 15 17:52:10 2011 -0700

Remove OPpENTERSUB_NOMOD from B::Concise

M   ext/B/B/Concise.pm

commit d26376f0cba86f87a4770b29227457e5c2b4a1db
Author: Gerard Goossen 
Date:   Sat Aug 13 18:51:48 2011 +0200

Remove OPpENTERSUB_NOMOD.

OPpENTERSUB_NOMOD was always set in combination with OPf_WANT_VOID
which is now used to not propagate the lvalue context, making
OPpENTERSUB_NOMOD redundant.

M   dump.c
M   op.c
M   op.h

commit 5c906035ffb6b2857a0f941a97ac9e7bb4126275
Author: Gerard Goossen 
Date:   Sat Aug 13 18:38:13 2011 +0200

Propagate lvalue context only to children of list ops which are not in void 
context.

Children list ops might be in void context because the list is in scalar
context. A test that discarded elements in a list are not assigned lvalue
context is added.
Children of a list op might also be in void context because they are
special entersub ops for attributes. This patch makes the
OPpENTERSUB_NOMOD flag redundant.

M   op.c
M   t/op/list.t
---

Summary of changes:
 dump.c |3 ---
 ext/B/B/Concise.pm |4 ++--
 op.c   |   10 ++
 op.h   |1 -
 t/op/list.t|9 -
 5 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/dump.c b/dump.c
index c32807c..c19cb8e 100644
--- a/dump.c
+++ b/dump.c
@@ -811,7 +811,6 @@ const struct flag_to_name op_trans_names[] = {
 const struct flag_to_name op_entersub_names[] = {
 {OPpENTERSUB_DB, ",DB"},
 {OPpENTERSUB_HASTARG, ",HASTARG"},
-{OPpENTERSUB_NOMOD, ",NOMOD"},
 {OPpENTERSUB_AMPER, ",AMPER"},
 {OPpENTERSUB_NOPAREN, ",NOPAREN"},
 {OPpENTERSUB_INARGS, ",INARGS"}
@@ -2962,8 +2961,6 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const 
OP *o)
sv_catpv(tmpsv, ",NOPAREN");
if (o->op_private & OPpENTERSUB_INARGS)
sv_catpv(tmpsv, ",INARGS");
-   if (o->op_private & OPpENTERSUB_NOMOD)
-   sv_catpv(tmpsv, ",NOMOD");
}
else {
switch (o->op_private & OPpDEREF) {
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index f427fe6..3849e17 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.84";
+our $VERSION   = "0.85";
 our @ISA   = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
 concise_subref concise_cv concise_main
@@ -611,7 +611,7 @@ $priv{$_}{4} = "DREFed" for (qw(rv2sv rv2av rv2hv));
 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
   for (qw(rv2gv rv2sv padsv aelem helem));
 $priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");
-@{$priv{"entersub"}}{1,4,16,32,64} = qw( DREF INARGS DBG TARG NOMOD );
+@{$priv{"entersub"}}{1,4,16,32,64} = qw( DREF INARGS DBG TARG );
 @{$priv{rv2cv}}{1,8,128} = ("CONST","AMPER","NO()");
 $priv{"gv"}{32} = "EARLYCV";
 $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
diff --git a/op.c b/op.c
index 775705b..92fed2b 100644
--- a/op.c
+++ b/op.c
@@ -1718,6 +1718,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
return o;
 }
 
+assert( (o->op_flags & OPf_WANT) != OPf_WANT_VOID );
+
 switch (o->op_type) {
 case OP_UNDEF:
localize = 0;
@@ -1757,8 +1759,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark 
*/
break;
}
-   else if (o->op_private & OPpENTERSUB_NOMOD)
-   return o;
else {  /* lvalue subroutine call */
o->op_private |= OPpLVAL_INTRO
   |(OPpENTERSUB_INARGS * (type == OP_LEAVESUBLV));
@@ -2016,7 +2016,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 case OP_LIST:
localize = 0;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
-   op_lvalue(kid, type);
+   /* elements might be in void context because the list is
+  in scalar context or because they are attribute sub calls */
+   if ( (kid->op_flags & OPf_WANT) != OPf_WANT_VOID )
+   op_lvalue(kid, type);
break;
 
 case OP_RETURN:
@@ -2351,7 +2354,6 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, 
OP **imopsp)
   op_append_elem(OP_LIST,
   op_prepend_elem(OP_LIST, pack, list(arg)),

[perl.git] branch blead, updated. v5.15.1-298-gc192154

2011-08-15 Thread Steve Hay 
In perl.git, the branch blead has been updated



- Log -
commit c192154b7b5060196110d20f17b18135fa216641
Author: Steve Hay 
Date:   Mon Aug 15 21:30:41 2011 +0100

Fix tabbing and trailing whitespace from commit f1d35e3443
and bump IO::Socket version.

M   dist/IO/lib/IO/Socket.pm

commit f1d35e3443aa8451bf47be80983076fe28626113
Author: Karthik Rajagopalan 
Date:   Thu Jul 14 13:36:41 2011 -0400

Use the exception set in select (connect()) to early return when remote end 
is busy or in non existing port

For non blocking socket, it a timeout has been specified, IO::Socket 
internally use select(..) to
detect the result of socket connection. In situation, where remote end is 
busy or in non-existing port, we spend
entire timeout mentioned in select(..) call. We cannot completely 
differentiate if error is WSAECONNREFUSED(10061) or
WSAETIMEDOUT(10060) in this situation. If we use the exception set in 
select(..) call, we can do early return and also
a make a clear differentiation in error condition. This is same like what 
Linux handle in this situation.

M   dist/IO/lib/IO/Socket.pm
---

Summary of changes:
 dist/IO/lib/IO/Socket.pm |   15 +--
 1 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index 31fa18f..ce493b5 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 
'symbian');
 
 @ISA = qw(IO::Handle);
 
-$VERSION = "1.32";
+$VERSION = "1.33";
 
 @EXPORT_OK = qw(sockatmark);
 
@@ -118,7 +118,18 @@ sub connect {
my $sel = new IO::Select $sock;
 
undef $!;
-   if (!$sel->can_write($timeout)) {
+   my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout);
+   if(@$e[0]) {
+   # Windows return from select after the timeout in case of
+   # WSAECONNREFUSED(10061) if exception set is not used.
+   # This behavior is different from Linux.
+   # Using the exception
+   # set we now emulate the behavior in Linux
+   #- Karthik Rajagopalan
+   $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR);
+   $@ = "connect: $err";
+   }
+   elsif(!@$w[0]) {
$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
$@ = "connect: timeout";
}

--
Perl5 Master Repository

[perl.git] branch blead, updated. v5.15.1-296-ga67abb3

2011-08-15 Thread Father Chrysostomos 
In perl.git, the branch blead has been updated



- Log -
commit a67abb3a612378541686808d03031e4055824b7d
Author: Father Chrysostomos 
Date:   Mon Aug 15 12:45:28 2011 -0700

generic perldelta entry for prototype changes

M   pod/perldelta.pod

commit 0bbad7483f446e61b319d774f9c5d184a33ea442
Author: Father Chrysostomos 
Date:   Mon Aug 15 09:28:51 2011 -0700

&CORE::not and &CORE::getprotobynumber

These two are now supported.  They were not before, because their
prototypes gave them unary precedence, even though these ops both
have list precedence.  That was corrected in the previous commit.

M   gv.c
M   lib/CORE.pod
M   pod/perldelta.pod
M   t/op/coreinline.t

commit dcbdef25d6257b5884d709cd40a0fdf5314546ef
Author: Father Chrysostomos 
Date:   Mon Aug 15 09:23:50 2011 -0700

Give not and getprotobynumber listop prototypes

They parse as list operators, but their prototypes imply unop
precedence.

M   op.c
M   t/op/cproto.t

commit 3a8944db48a72ff3e936211f8b0433b10f3c6c80
Author: Father Chrysostomos 
Date:   Mon Aug 15 09:20:08 2011 -0700

Document and test $; prototype syntax

This has worked this way for yonks.  It is actually useful, so it might
as well be documented.

M   pod/perlsub.pod
M   t/comp/proto.t
---

Summary of changes:
 gv.c  |5 +
 lib/CORE.pod  |2 +-
 op.c  |1 +
 pod/perldelta.pod |9 +
 pod/perlsub.pod   |6 +-
 t/comp/proto.t|   13 -
 t/op/coreinline.t |6 +++---
 t/op/cproto.t |4 ++--
 8 files changed, 30 insertions(+), 16 deletions(-)

diff --git a/gv.c b/gv.c
index 1741bda..aa306c8 100644
--- a/gv.c
+++ b/gv.c
@@ -1338,15 +1338,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN 
full_len, I32 flags,
SV *opnumsv;
if (code >= 0) return gv; /* not overridable */
 /* no support for \&CORE::infix;
-   no support for &CORE::not or &CORE::getprotobynumber
-   either, yet, as we cannot get the precedence right;
no support for funcs that take labels, as their parsing is
weird  */
switch (-code) {
case KEY_and: case KEY_cmp: case KEY_CORE: case KEY_dump:
case KEY_eq: case KEY_ge:
-   case KEY_getprotobynumber: case KEY_gt: case KEY_le:
-   case KEY_lt: case KEY_ne: case KEY_not:
+   case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne:
case KEY_or: case KEY_x: case KEY_xor:
return gv;
}
diff --git a/lib/CORE.pod b/lib/CORE.pod
index 1a98f76..10fa424 100644
--- a/lib/CORE.pod
+++ b/lib/CORE.pod
@@ -35,7 +35,7 @@ feature is new in Perl 5.16.  You can take references to 
these and make
 aliases.  However, they can only be called as barewords; i.e., you cannot
 use ampersand syntax (C<&foo>) or call them through references.  See the
 C example above.  This works for all overridable keywords, except
-for C, C, C and the infix operators.
+for C and the infix operators.
 
 =head1 OVERRIDING CORE FUNCTIONS
 
diff --git a/op.c b/op.c
index 6c46f2a..775705b 100644
--- a/op.c
+++ b/op.c
@@ -10420,6 +10420,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, 
const int code,
 }
 if (defgv && str[0] == '$')
str[0] = '_';
+if (code == -KEY_not || code == -KEY_getprotobynumber) str[n++] = ';';
 str[n++] = '\0';
 sv_setpvn(sv, str, n - 1);
 if (opnum) *opnum = i;
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 2309a09..6b68c5a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -37,8 +37,8 @@ must be called as barewords.  In other words, you can now do 
this:
 BEGIN { *entangle = \&CORE::tie }
 entangle $variable, $package, @args;
 
-This currently works for overridable keywords other than C, C,
-C and the infix operators.
+This currently works for overridable keywords other than C and the
+infix operators.
 
 Work is under way to allow these subroutines to be called through
 references.
@@ -490,8 +490,9 @@ no-op otherwise), but that may be rectified in a future 
version.
 
 =item *
 
-C's prototype has been corrected to C<(\[$@%&*])> from C<(\$)>, which
-was just wrong.
+The prototypes of several built-in functions--C, C,
+C and C--have been corrected, or at least are now closer to
+reality than before.
 
 =item *
 
diff --git a/pod/perlsub.pod b/pod/perlsub.pod
index d344c47..e2a9bcf 100644
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -1149,7 +1149,11 @@ arguments, just like C.  That is, if you say
 mytime +2;
 
 you'll get C, not C, which is how it would be parsed
-without a prototype.
+without a prototype.

[perl.git] branch blead, updated. v5.15.1-292-gf2f8fd8

2011-08-15 Thread Father Chrysostomos 
In perl.git, the branch blead has been updated



- Log -
commit f2f8fd84e14dfcfc614b0ccf9b24475ca5f173d4
Author: Gerard Goossen 
Date:   Tue Aug 9 21:33:27 2011 +0200

Move checking of CV to GV assigned (OPpASSIGN_CV_TO_GV) from the peephole 
optimizer to scalarvoid
---

Summary of changes:
 op.c |   86 +++--
 1 files changed, 41 insertions(+), 45 deletions(-)

diff --git a/op.c b/op.c
index b3c5f86..6c46f2a 100644
--- a/op.c
+++ b/op.c
@@ -1219,6 +1219,47 @@ Perl_scalarvoid(pTHX_ OP *o)
o->op_ppaddr = PL_ppaddr[OP_I_PREDEC];
break;
 
+case OP_SASSIGN: {
+   OP *rv2gv;
+   UNOP *refgen, *rv2cv;
+   LISTOP *exlist;
+
+   if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
+   break;
+
+   rv2gv = ((BINOP *)o)->op_last;
+   if (!rv2gv || rv2gv->op_type != OP_RV2GV)
+   break;
+
+   refgen = (UNOP *)((BINOP *)o)->op_first;
+
+   if (!refgen || refgen->op_type != OP_REFGEN)
+   break;
+
+   exlist = (LISTOP *)refgen->op_first;
+   if (!exlist || exlist->op_type != OP_NULL
+   || exlist->op_targ != OP_LIST)
+   break;
+
+   if (exlist->op_first->op_type != OP_PUSHMARK)
+   break;
+
+   rv2cv = (UNOP*)exlist->op_last;
+
+   if (rv2cv->op_type != OP_RV2CV)
+   break;
+
+   assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
+   assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
+   assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
+
+   o->op_private |= OPpASSIGN_CV_TO_GV;
+   rv2gv->op_private |= OPpDONT_INIT_GV;
+   rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
+
+   break;
+}
+
 case OP_OR:
 case OP_AND:
kid = cLOGOPo->op_first;
@@ -10171,51 +10212,6 @@ Perl_rpeep(pTHX_ register OP *o)
break;
}
 
-   case OP_SASSIGN: {
-   OP *rv2gv;
-   UNOP *refgen, *rv2cv;
-   LISTOP *exlist;
-
-   if ((o->op_flags & OPf_WANT) != OPf_WANT_VOID)
-   break;
-
-   if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
-   break;
-
-   rv2gv = ((BINOP *)o)->op_last;
-   if (!rv2gv || rv2gv->op_type != OP_RV2GV)
-   break;
-
-   refgen = (UNOP *)((BINOP *)o)->op_first;
-
-   if (!refgen || refgen->op_type != OP_REFGEN)
-   break;
-
-   exlist = (LISTOP *)refgen->op_first;
-   if (!exlist || exlist->op_type != OP_NULL
-   || exlist->op_targ != OP_LIST)
-   break;
-
-   if (exlist->op_first->op_type != OP_PUSHMARK)
-   break;
-
-   rv2cv = (UNOP*)exlist->op_last;
-
-   if (rv2cv->op_type != OP_RV2CV)
-   break;
-
-   assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
-   assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
-   assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
-
-   o->op_private |= OPpASSIGN_CV_TO_GV;
-   rv2gv->op_private |= OPpDONT_INIT_GV;
-   rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
-
-   break;
-   }
-
-   
case OP_QR:
case OP_MATCH:
if (!(cPMOP->op_pmflags & PMf_ONCE)) {

--
Perl5 Master Repository

[perl.git] branch blead, updated. v5.15.1-291-gd0580c0

2011-08-15 Thread Jesse Vincent 
In perl.git, the branch blead has been updated



- Log -
commit d0580c073780ff3a1d0eb8a91441553a8bc6dee9
Merge: d6655a3 5840c18
Author: Jesse Vincent 
Date:   Mon Aug 15 22:20:53 2011 +0300

Merge branch 'blead' of ssh://perl5.git.perl.org/perl into blead

* 'blead' of ssh://perl5.git.perl.org/perl: (198 commits)
  CORE.pod: fix nit grammar
  podcheck.t pod grammar fix
  Make lock(&foo) syntax nominally lock the subroutine
  Forgot one in d677d0fca41325ba7203de00652fdeb43659754a.
  Write some missing version strings in configure.com
  Correct some format strings in configure.com.
  Improve comments about op_private bits. And move the non op specific 
flags to the top.
  get authors.t passing again
  Update AUTHORS file and convert from Latin-1 to UTF-8
  perldiag.pod on defined %hash
  perldelta for &CORE::foo
  Update core_prototype’s docs
  Move pp_-specific code out of core_prototype
  Change core_prototype to take a keyword num
  Add tests for precedence of CORE:: subs
  Add inlinable &CORE::functions
  Make core_prototype provide the op number as well
  Make sure the CORE package is always called CORE
  Remove select’s prototype
  B::Terse and B::Xref were missing some documentation.
  ...

commit d6655a35db9c09cc4a4eeae16b9ec49c7881b1ab
Author: Jesse Vincent 
Date:   Mon Aug 15 22:20:23 2011 +0300

Add Abigail as a release manager

M   Porting/release_schedule.pod
---

Summary of changes:
 Porting/release_schedule.pod |3 ++-
 1 files changed, 2 insertions(+), 1 deletions(-)

diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod
index 5206d8e..fd18633 100644
--- a/Porting/release_schedule.pod
+++ b/Porting/release_schedule.pod
@@ -69,7 +69,7 @@ Release schedule (with release managers and code freeze 
points):
   2011-12-20  5.15.6  Dave Rolsky (Contentious code freeze)
   2012-01-20  5.15.7  Chris Williams
   2012-02-20  5.15.8  ??? (User-visible code freeze)
-  2012-03-20  5.15.9  ??? (Full code freeze)
+  2012-03-20  5.15.9  Abigail (Full code freeze)
 
 =head1 VICTIMS
 
@@ -96,6 +96,7 @@ Zefram 
 Ævar Arnfjörð Bjarmason 
 Stevan Little 
 Dave Rolsky 
+Abigail 
 
 =head2 Reticent victims
 

--
Perl5 Master Repository

[perl.git] branch blead, updated. v5.15.1-287-gf79aa60

2011-08-15 Thread Father Chrysostomos 
In perl.git, the branch blead has been updated



- Log -
commit f79aa60b66082c8bff80f325979742bfb6c73709
Author: Father Chrysostomos 
Date:   Sun Aug 14 19:16:14 2011 -0700

Make lock(&foo) syntax nominally lock the subroutine

In 5.10, lock(&foo) was an error for non-lvalue subs.  For lvalue
subs, it passed &foo to the lockhook and return \&foo.

In 5.12, lock(&foo) was still an error for non-lvalue subs.  For
lvalue subs, it would pass &foo to the lockhook and then either
trip an assertion (-DDEBUGGING) or return &foo, resulting in inter-
esting bugs.

Commit f4df43b5e changed lock(&lvalue_sub) to call the sub and lock
its return value.

As Reini Urban pointed out in
,
locking a subroutine does have its uses.

Since lock(&foo) has never really worked anyway, we can still
change this.

So, for lvalue subs, this reverts back to the 5.10 behaviour.  For
non-lvalue subs, it now behaves the same way, the lvalue flag making
no difference.  Note that it still causes an error at run-time, if
threads::shared is loaded, as its lockhook is conservative in what
it accepts.

But this change allows for future extensibility, unlike f4df43b5e.

A note about the implementation: There are two pieces of code (at
least) in op.c that convert an entersub op into an rv2cv, one in
S_doref and the other in Perl_op_lvalue_flags.  Originally (before
f4df43b5e) it was S_doref that took care of that for OP_LOCK.  But
Perl_op_lvalue_flags is called first, so it would assume it was an
assignment to a sub call and croak if there was no lvalue sub in the
symbol table.  This commit adds back the special case for OP_LOCK, but
in Perl_op_lvalue_flags, not S_doref.
---

Summary of changes:
 op.c  |3 ++-
 pod/perldelta.pod |   13 -
 pod/perlfunc.pod  |2 +-
 pp.c  |4 ++--
 t/op/cproto.t |2 +-
 t/op/lock.t   |6 ++
 6 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/op.c b/op.c
index 4f8693a..b3c5f86 100644
--- a/op.c
+++ b/op.c
@@ -1705,7 +1705,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
break;
goto nomod;
 case OP_ENTERSUB:
-   if ((type == OP_UNDEF || type == OP_REFGEN) &&
+   if ((type == OP_UNDEF || type == OP_REFGEN || type == OP_LOCK) &&
!(o->op_flags & OPf_STACKED)) {
o->op_type = OP_RV2CV;  /* entersub => rv2cv */
/* Both ENTERSUB and RV2CV use this bit, but for different pur-
@@ -10415,6 +10415,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, 
const int code,
str[n++] = '$';
str[n++] = '@';
str[n++] = '%';
+   if (i == OP_LOCK) str[n++] = '&';
str[n++] = '*';
str[n++] = ']';
}
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 0d87c3a..2309a09 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -480,14 +480,17 @@ L.
 
 =item *
 
-Locking an lvalue subroutine (via C) now locks the return
-value, instead of trying to lock the sub (which has no effect).  It also no
-longer tries to return the sub as a scalar, resulting in strange side
-effects like C returning "CODE" in some instances.
+Locking a subroutine (via C) is no longer a compile-time error
+for regular subs.  For lvalue subroutines, it no longer tries to return the
+sub as a scalar, resulting in strange side effects like C
+returning "CODE" in some instances.
+
+C is now a run-time error if L is loaded (a
+no-op otherwise), but that may be rectified in a future version.
 
 =item *
 
-C's prototype has been corrected to C<(\[$@%*])> from C<(\$)>, which
+C's prototype has been corrected to C<(\[$@%&*])> from C<(\$)>, which
 was just wrong.
 
 =item *
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 264fbdc..04c6a05 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -3095,7 +3095,7 @@ This function places an advisory lock on a shared 
variable or referenced
 object contained in I until the lock goes out of scope.
 
 The value returned is the scalar itself, if the argument is a scalar, or a
-reference, if the argument is a hash or array.
+reference, if the argument is a hash, array or subroutine.
 
 lock() is a "weak keyword" : this means that if you've defined a function
 by this name (before any calls to it), that function will be called
diff --git a/pp.c b/pp.c
index ca94935..3421d97 100644
--- a/pp.c
+++ b/pp.c
@@ -5914,9 +5914,9 @@ PP(pp_lock)
 dSP;
 dTOPss;
 SV *retsv = sv;
-assert(SvTYPE(retsv) != SVt_PVCV);
 SvLOCK(sv);
-if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) ==

[perl.git] branch blead, updated. v5.15.1-289-g5840c18

2011-08-15 Thread Karl Williamson 
In perl.git, the branch blead has been updated



- Log -
commit 5840c18f54d64eedd62c14cfd8d5afafb86c61bd
Author: Karl Williamson 
Date:   Mon Aug 15 09:01:27 2011 -0600

CORE.pod: fix nit grammar

M   lib/CORE.pod

commit 5b1cac40b9ebeb00508d2a1bf123bb180abf1809
Author: Karl Williamson 
Date:   Wed Aug 10 09:47:28 2011 -0600

podcheck.t pod grammar fix

M   t/porting/podcheck.t
---

Summary of changes:
 lib/CORE.pod |2 +-
 t/porting/podcheck.t |2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/CORE.pod b/lib/CORE.pod
index d2175eb..1a98f76 100644
--- a/lib/CORE.pod
+++ b/lib/CORE.pod
@@ -20,7 +20,7 @@ CORE - Namespace for Perl's core routines
 The C namespace gives access to the original built-in functions of
 Perl.  The C package is built into
 Perl, and therefore you do not need to use or
-require an hypothetical "CORE" module prior to accessing routines in this
+require a hypothetical "CORE" module prior to accessing routines in this
 namespace.
 
 A list of the built-in functions in Perl can be found in L.
diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t
index a1f35a1..5c10543 100644
--- a/t/porting/podcheck.t
+++ b/t/porting/podcheck.t
@@ -78,7 +78,7 @@ It's annoying to have lines wrap when displaying pod 
documentation in a
 terminal window.  This checks that all verbatim lines fit in a standard 80
 column window, even when using a pager that reserves a column for its own use.
 (Thus the check is for a net of 79 columns.)
-For those that lines that don't fit, it tells you how much needs to be cut in
+For those lines that don't fit, it tells you how much needs to be cut in
 order to fit.
 
 Often, the easiest thing to do to gain space for these is to lower the indent

--
Perl5 Master Repository

[perl.git] branch davem/re_eval, updated. v5.15.1-37-ge04b857

2011-08-15 Thread Dave Mitchell 
In perl.git, the branch davem/re_eval has been updated



- Log -
commit e04b85764f6d15d12d2a25b56d117f71c4ce6f51
Author: David Mitchell 
Date:   Mon Aug 8 17:56:10 2011 +0100

re_eval and closures: add lots of TODO tests

re_evals currently almost always do the wrong thing as regards what
lexical variable they refer to. This commit adds lots of TODO tests that
show what behaviour I think there should be. Note that because hardly any
of these tests pass yet, I haven't been able to verify whether they have
any subtle typos etc.

The basic philosophy behind these tests is:

* literal code is compiled once at compile-time and shares the same
  lexical environment as its surroundings; i.e.

/A(?{..$x..})B/

  is like

/A/ && do {..$x..} && /B/

* qr is treated as a closure: compiling once, but capturing its
  environment anew each time it is instantiated; i.e.

for my $x (...) { push @r, qr/A(?{..$x..}B)/ }

  is like

for my $x (...) { push @r, sub { /A/ && do {..$x..} && /B/ } }

* run-time code is recompiled each time the regex is compiled; literal
  code in the same expression isn't recompiled; i.e.

$code = '(?{ BEGIN{$y++} })';
for (1..3) { /(?{ BEGIN{$x++}})$code/ }
# x==1, y==3

* an embedded qr is not stringified, so the qr retains its original
  lexical environment; i.e.

  $x = 1;
  { my $x = 2: $r = qr/(??{$x})/ }
  /A$r/; # matches A2, not A1
---

Summary of changes:
 t/re/pat_re_eval.t |  128 +++-
 1 files changed, 127 insertions(+), 1 deletions(-)

diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index 5a79942..262e6f3 100644
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -22,7 +22,7 @@ BEGIN {
 }
 
 
-plan tests => 127;  # Update this when adding/deleting tests.
+plan tests => 214;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -353,6 +353,132 @@ sub run_tests {
ok('ja' =~ /^\L(??{"$B\Ea"})$/,  '^\L(??{"$B\Ea"})$');
 }
 
+{
+   # Comprehensive (hopefully) tests of closure behaviour:
+   # i.e. when do (?{}) blocks get (re)compiled, and what instances
+   # of lexical vars do they close over?
+
+   # XXX remove this when TODOs are fixed
+   # like ok, but 1st arg indicates TODO
+   sub tok($$$) {
+   my $todo = shift;
+   local $::TODO = 're_eval lexical madness' if $todo;
+   ok($_[0], $_[1]);
+   }
+
+   # XXX remove this when TODOs are fixed
+   no warnings qw(uninitialized closure);
+
+   my ($cr1, $cr2, $cr3, $cr4);
+
+   use re 'eval';
+   for my $x (qw(a b c)) {
+   my $bc = ($x ne 'a');
+
+   # the most basic: literal code should be in same scope
+   # as the parent
+
+   tok(1,   "A$x" =~ /^A(??{$x})$/, "[$x] literal code");
+
+   # the "don't recompile if pattern unchanged" mechanism
+   # shouldn't apply to code blocks - recompile every time
+   # to pick up new instances of variables
+
+   my $code1 = 'B(??{$x})';
+   tok($bc, "AB$x" =~ /^A$code1$/, "[$x] unvarying runtime code");
+
+   # mixed literal and run-time code blocks
+
+   my $code2 = 'B(??{$x})';
+   tok($bc, "A$x-B$x" =~ /^A(??{$x})-$code2$/, "[$x] literal+runtime");
+
+   # literal qr code only created once, naked
+
+   $cr1 //= qr/^A(??{$x})$/;
+   tok(1,   "Aa" =~ $cr1, "[$x] literal qr once naked");
+
+   # literal qr code only created once, embedded with text
+
+   $cr2 //= qr/B(??{$x})$/;
+   tok(0,   "ABa" =~ /^A$cr2/, "[$x] literal qr once embedded text");
+
+   # literal qr code only created once, embedded with text + lit code
+
+   $cr3 //= qr/C(??{$x})$/;
+   tok($bc, "A$x-BCa" =~ /^A(??{$x})-B$cr3/,
+   "[$x] literal qr once embedded text + lit code");
+
+   # literal qr code only created once, embedded with text + run code
+
+   $cr4 //= qr/C(??{$x})$/;
+   my $code3 = 'A(??{$x})';
+   tok(1,   "A$x-BCa" =~ /^A$code3-B$cr4/,
+   "[$x] literal qr once embedded text + run code");
+
+   # literal qr code, naked
+
+   my $r1 = qr/^A(??{$x})$/;
+   tok(1,   "A$x" =~ $r1, "[$x] literal qr naked");
+
+   # literal qr code, embedded with text
+
+   my $r2 = qr/B(??{$x})$/;
+   tok($bc, "AB$x" =~ /^A$r2/, "[$x] literal qr embedded text");
+
+   # literal qr code, embedded with text + lit code
+
+