[perl.git] branch blead updated. v5.27.6-127-g0740a29d60

[Zefram]

In perl.git, the branch blead has been updated



- Log -
commit 0740a29d60ebd4ff72090340b0140ec2210e90c7
Author: Zefram 
Date:   Tue Dec 5 06:13:27 2017 +

stop using _sv_yes as no-op method

Method lookup yields a fake method for ->import or ->unimport if there's
no actual method, for historical reasons so that "use" doesn't barf
if there's no import method.  This fake method used to be _sv_yes
being used as a magic placeholder, recognised specially by pp_entersub.
But _sv_yes is a string, which we'd expect to serve as a symbolic
CV ref.  Change method lookup to yield an actual CV with a body in this
case, and remove the special case from pp_entersub.  This fixes the
remaining part of [perl #126042].

---

Summary of changes:
 ext/XS-APItest/APItest.xs | 10 +-
 ext/XS-APItest/t/call.t   |  2 +-
 gv.c  |  7 ---
 pp_hot.c  | 10 --
 t/op/method.t | 47 +--
 t/op/sub.t| 26 +-
 6 files changed, 44 insertions(+), 58 deletions(-)

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 5ceb7fe939..891b7e71d4 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2339,9 +2339,17 @@ CODE:
only current internal behavior, these tests can be changed in the
future if necessery */
 PUSHMARK(SP);
-retcnt = call_sv(_sv_yes, 0); /* does nothing */
+retcnt = call_sv(_sv_yes, G_EVAL);
 SPAGAIN;
 SP -= retcnt;
+errsv = ERRSV;
+errstr = SvPV(errsv, errlen);
+if(memBEGINs(errstr, errlen, "Undefined subroutine ::1 called at")) {
+PUSHMARK(SP);
+retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
+SPAGAIN;
+SP -= retcnt;
+}
 PUSHMARK(SP);
 retcnt = call_sv(_sv_no, G_EVAL);
 SPAGAIN;
diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t
index 355e49886e..8192b9bd36 100644
--- a/ext/XS-APItest/t/call.t
+++ b/ext/XS-APItest/t/call.t
@@ -33,7 +33,7 @@ sub i {
 $call_sv_count++;
 }
 call_sv_C();
-is($call_sv_count, 6, "call_sv_C passes");
+is($call_sv_count, 7, "call_sv_C passes");
 
 sub d {
 die "its_dead_jim\n";
diff --git a/gv.c b/gv.c
index bc5b388588..00adb8995c 100644
--- a/gv.c
+++ b/gv.c
@@ -1091,9 +1091,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const 
char *name, const STRLEN le
/* This is the special case that exempts Foo->import and
   Foo->unimport from being an error even if there's no
  import/unimport subroutine */
-   if (strEQ(name,"import") || strEQ(name,"unimport"))
-   gv = MUTABLE_GV(_sv_yes);
-   else if (autoload)
+   if (strEQ(name,"import") || strEQ(name,"unimport")) {
+   gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL,
+   NULL, 0, 0, NULL));
+   } else if (autoload)
gv = gv_autoload_pvn(
ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
);
diff --git a/pp_hot.c b/pp_hot.c
index 7609638b8f..87e60970d6 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -5007,16 +5007,6 @@ PP(pp_entersub)
 if (UNLIKELY(!SvOK(sv)))
 DIE(aTHX_ PL_no_usym, "a subroutine");
 
-if (UNLIKELY(sv == _sv_yes)) { /* unfound import, ignore */
-if (PL_op->op_flags & OPf_STACKED) /* hasargs */
-SP = PL_stack_base + POPMARK;
-else
-(void)POPMARK;
-if (GIMME_V == G_SCALAR)
-PUSHs(_sv_undef);
-RETURN;
-}
-
 sym = SvPV_nomg_const(sv, len);
 if (PL_op->op_private & HINT_STRICT_REFS)
 DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a 
subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
diff --git a/t/op/method.t b/t/op/method.t
index 82f8263a10..d0fc321804 100644
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -13,7 +13,35 @@ BEGIN {
 use strict;
 no warnings 'once';
 
-plan(tests => 151);
+plan(tests => 162);
+
+{
+# RT #126042 &{1==1} * &{1==1} would crash
+# There are two issues here.  Method lookup yields a fake method for
+# ->import or ->unimport if there's no actual method, for historical
+# reasons so that "use" doesn't barf if there's no import method.
+# The first bug, the one which caused the crash, is that the fake
+# method was broken in scalar context, messing up the stack.  We test
+# for that on its own.
+foreach my $meth (qw(import 

[perl.git] branch tonyc/127743-cperl-storable-fixes updated. v5.27.6-176-g69b3f9233f

[Tony Cook]

In perl.git, the branch tonyc/127743-cperl-storable-fixes has been updated



- Log -
commit 69b3f9233f147fd65005942ffc200c502847b01e
Author: Tony Cook 
Date:   Tue Dec 5 05:24:20 2017 +0100

(perl #127743) support for >= 4GB data from hooks

Though we use this mechanism for >= 2GB.

This emits an SX_LOBJECT op and writes the string length as a 64-bit
value if STORABLE_attach() returns more than 2GB of data.

The boundary is set at 2GB since older versions of Storable handle
sizes between 2GB and 4GB badly, resulting in a memory overwrite.  By
using the alternate op codes an older Storable will reject the data
instead.

We still accept such data that might have been written by an older
Storable.

commit adc6b5a1b5b347f66b06957f112a9ac4db833891
Author: Tony Cook 
Date:   Tue Dec 5 00:42:48 2017 +0100

(perl #131999) treat a 32-bit hook data size as unsigned

Previously retrieve_hook() treated the 32-bit hook data size as a signed 
value, but
the parameter to NEWSV() is treated as unsigned.  Due to promotion rules 
this negative
signed value is converted to a very large unsigned value running us out of 
memory.

Fixing this bug will let us accept previously frozen hook data in the
2GB to 4GB rannge.  The next commit will hopefully allow us to write
and read 4GB+ data correctly.

---

Summary of changes:
 dist/Storable/Storable.xs | 51 +
 dist/Storable/t/hugeids.t | 83 +--
 2 files changed, 125 insertions(+), 9 deletions(-)

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 29d4c79963..f380faa007 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -1428,6 +1428,8 @@ static const sv_retrieve_t sv_old_retrieve[] = {
 (sv_retrieve_t)retrieve_other, /* SX_LOBJECT not supported */
 };
 
+static SV *retrieve_hook_common(pTHX_ stcxt_t *cxt, const char *cname, int 
large);
+
 static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname);
 static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname);
 static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname);
@@ -3694,7 +3696,11 @@ static int store_hook(
 
 /* [SX_HOOK]  [] */
 if (!recursed++) {
-PUTMARK(SX_HOOK);
+#ifdef HAS_U64
+if (len2 > INT32_MAX)
+PUTMARK(SX_LOBJECT);
+#endif
+   PUTMARK(SX_HOOK);
 PUTMARK(flags);
 if (obj_type == SHT_EXTRA)
 PUTMARK(eflags);
@@ -3810,7 +3816,11 @@ static int store_hook(
 
 /* SX_HOOK  [] */
 if (!recursed) {
-PUTMARK(SX_HOOK);
+#ifdef HAS_U64
+if (len2 > INT32_MAX)
+   PUTMARK(SX_LOBJECT);
+#endif
+   PUTMARK(SX_HOOK);
 PUTMARK(flags);
 if (obj_type == SHT_EXTRA)
 PUTMARK(eflags);
@@ -3836,8 +3846,14 @@ static int store_hook(
 }
 
 /*   */
+#ifdef HAS_U64
+if (len2 > INT32_MAX) {
+W64LEN(len2);
+}
+else
+#endif
 if (flags & SHF_LARGE_STRLEN) {
-I32 wlen2 = len2;  /* STRLEN might be 8 bytes */
+U32 wlen2 = len2;  /* STRLEN might be 8 bytes */
 WLEN(wlen2);   /* Must write an I32 for 64-bit 
machines */
 } else {
 unsigned char clen = (unsigned char) len2;
@@ -4693,13 +4709,13 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const 
char *cname)
  * processing (since we won't have seen the magic object by the time the hook
  * is called).  See comments below for why it was done that way.
  */
-static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
+static SV *retrieve_hook_common(pTHX_ stcxt_t *cxt, const char *cname, int 
large)
 {
 U32 len;
 char buf[LG_BLESS + 1];/* Avoid malloc() if possible */
 char *classname = buf;
 unsigned int flags;
-I32 len2;
+STRLEN len2;
 SV *frozen;
 I32 len3 = 0;
 AV *av = 0;
@@ -4720,6 +4736,11 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char 
*cname)
 TRACEME(("retrieve_hook (#%d)", (int)cxt->tagnum));
 ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
+#ifndef HAS_U64
+assert(!large);
+PERL_UNUSED_ARG(large);
+#endif
+
 /*
  * Read flags, which tell us about the type, and whether we need
  * to recurse.
@@ -4868,8 +4889,17 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char 
*cname)
  * To understand that code, read retrieve_scalar()
  */
 
-if (flags & SHF_LARGE_STRLEN)
-RLEN(len2);
+#ifdef HAS_U64
+if (large) {
+READ_U64(len2);
+}
+ 

[perl.git] branch blead updated. v5.27.6-126-g28ef70489d

[Zefram]

In perl.git, the branch blead has been updated



- Log -
commit 28ef70489d76deb9024de42a0571162f323148c8
Author: Zefram 
Date:   Tue Dec 5 03:05:51 2017 +

document newATTRSUB_x()

commit a59b17fa6324328a12a1d86a5e187e07ba8cee6c
Author: Zefram 
Date:   Tue Dec 5 00:02:10 2017 +

more fully document newCONSTSUB{,_flags}()

commit 68cd13c6081a23a59561d3289dba5a99f73c1463
Author: Zefram 
Date:   Mon Dec 4 22:44:07 2017 +

document newXS_len_flags()

commit 8bfeb7823012732f6bfd9c65485ae3ad9c0cce8d
Author: Zefram 
Date:   Mon Dec 4 17:13:08 2017 +

avoid attaching prototype to freed XS sub

XS sub creation in newXS_len_flags() was applying the prototype after
process_special_blocks(), which could free the sub if it's a BEGIN.
Track whether that's freed the sub, in the same way that newATTRSUB_x()
does, and skip adding the prototype if it's been freed.  Also sprinkle
some assertions throughout sub building code, about the sub being live.

This arises from [perl #125806], and prevents the immediate cause of its
segv, but doesn't actually fix it.  The test case there still fails, a bit
later on in newCONSTSUB_flags(), now hitting one of the new assertions.

---

Summary of changes:
 embed.fnc |   4 +-
 op.c  | 255 +-
 2 files changed, 239 insertions(+), 20 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index d174290aae..a1678ec2c3 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1114,7 +1114,7 @@ ApdR  |OP*|newSLICEOP |I32 flags|NULLOK OP* 
subscript|NULLOK OP* listop
 ApdR   |OP*|newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o
 Apbm   |CV*|newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto \
|NULLOK OP* block
-p  |CV *   |newXS_len_flags|NULLOK const char *name|STRLEN len \
+pd |CV *   |newXS_len_flags|NULLOK const char *name|STRLEN len \
|NN XSUBADDR_t subaddr\
|NULLOK const char *const filename \
|NULLOK const char *const proto \
@@ -1995,7 +1995,7 @@ AnpMd |SV*|sv_get_backrefs|NN SV *const sv
 p  |int|magic_killbackrefs|NN SV *sv|NN MAGIC *mg
 Ap |OP*|newANONATTRSUB |I32 floor|NULLOK OP *proto|NULLOK OP 
*attrs|NULLOK OP *block
 Am |CV*|newATTRSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK 
OP *attrs|NULLOK OP *block
-pX |CV*|newATTRSUB_x   |I32 floor|NULLOK OP *o|NULLOK OP *proto \
+pdX|CV*|newATTRSUB_x   |I32 floor|NULLOK OP *o|NULLOK OP *proto \
 |NULLOK OP *attrs|NULLOK OP *block \
 |bool o_is_gv
 Ap |CV *   |newMYSUB   |I32 floor|NN OP *o|NULLOK OP *proto \
diff --git a/op.c b/op.c
index 7d0185f650..072d3ceb53 100644
--- a/op.c
+++ b/op.c
@@ -9602,6 +9602,85 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP 
*attrs, OP *block)
 return cv;
 }
 
+/*
+=for apidoc m|CV *|newATTRSUB_x|I32 floor|OP *o|OP *proto|OP *attrs|OP 
*block|bool o_is_gv
+
+Construct a Perl subroutine, also performing some surrounding jobs.
+
+This function is expected to be called in a Perl compilation context,
+and some aspects of the subroutine are taken from global variables
+associated with compilation.  In particular, C represents
+the subroutine that is currently being compiled.  It must be non-null
+when this function is called, and some aspects of the subroutine being
+constructed are taken from it.  The constructed subroutine may actually
+be a reuse of the C object, but will not necessarily be so.
+
+If C is null then the subroutine will have no body, and for the
+time being it will be an error to call it.  This represents a forward
+subroutine declaration such as S.  If C is
+non-null then it provides the Perl code of the subroutine body, which
+will be executed when the subroutine is called.  This body includes
+any argument unwrapping code resulting from a subroutine signature or
+similar.  The pad use of the code must correspond to the pad attached
+to C.  The code is not expected to include a C or
+C op; this function will add such an op.  C is consumed
+by this function and will become part of the constructed subroutine.
+
+C specifies the subroutine's prototype, unless one is supplied
+as an attribute (see below).  If C is null, then the subroutine
+will not have a prototype.  If C is non-null, it must point to a
+C op whose value is a string, and the subroutine will have that
+string as its prototype.  If a prototype is supplied as an attribute, the

[perl.git] branch blead updated. v5.27.6-122-g76b35304cf

[Father Chrysostomos]

In perl.git, the branch blead has been updated



- Log -
commit 76b35304cf4800e9e0f7b370b9f1f40bc6cfb7e0
Author: Father Chrysostomos 
Date:   Mon Dec 4 15:29:45 2017 -0800

Make Bad name error less unhelpful

This was brought up in perl #132485.

Because ‘Bad name after...’ is a croak, it suppresses the more helpful
hints like ‘Might be a runaway multi-line string’, in such cases as:

use Moose;

has erdef => (
isa => 'Int',
is => 'ro,
default => sub { 1 }
);

has cxxc => (
isa => 'Int',
is => 'ro',
default => sub { 1 }
);

We can allay this infelicity by emitting the ‘Missing operator before
bareword’ before the Bad name croak, so in the example above we
end up with:

Bareword found where operator expected at - line 10, near "isa => 'Int"
  (Might be a runaway multi-line '' string starting on line 5)
(Do you need to predeclare isa?)
Bad name after Int' at - line 10.

rather than just:

Bad name after Int' at - line 10.

---

Summary of changes:
 t/lib/croak/toke | 38 ++
 toke.c   | 26 ++
 2 files changed, 56 insertions(+), 8 deletions(-)

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index aadb447dc4..082761eec4 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -289,6 +289,44 @@ Too many arguments for undef operator at - line 11, near 
"2)"
 Constant(q) unknown at - line 12, near ""a""
 - has too many errors.
 
+# NAME Bad name after ' (with other helpful messages)
+sub has{}
+has erdef => (
+isa => 'Int',
+is => 'ro,
+default => sub { 1 }
+);
+
+has cxxc => (
+isa => 'Int',
+is => 'ro',
+default => sub { 1 }
+);
+EXPECT
+Bareword found where operator expected at - line 9, near "isa => 'Int"
+  (Might be a runaway multi-line '' string starting on line 4)
+   (Do you need to predeclare isa?)
+Bad name after Int' at - line 9.
+
+# NAME Bad name after :: (with other helpful messages)
+sub has{}
+has erdef => (
+isa => 'Int',
+is => "ro,
+default => sub { 1 }
+);
+
+has cxxc => (
+isa => "Foo::$subpackage",
+is => 'ro',
+default => sub { 1 }
+);
+EXPECT
+Bareword found where operator expected at - line 9, near "isa => "Foo"
+  (Might be a runaway multi-line "" string starting on line 4)
+   (Do you need to predeclare isa?)
+Bad name after Foo:: at - line 9.
+
 # NAME Unterminated delimiter for here document
 <<"foo
 EXPECT
diff --git a/toke.c b/toke.c
index 1074e7aed6..70e7de01de 100644
--- a/toke.c
+++ b/toke.c
@@ -7266,7 +7266,20 @@ Perl_yylex(pTHX)
int pkgname = 0;
const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : 
PL_bufptr[-1]);
bool safebw;
+   bool no_op_error = FALSE;
 
+   if (PL_expect == XOPERATOR) {
+   if (PL_bufptr == PL_linestart) {
+   CopLINE_dec(PL_curcop);
+   Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", 
PL_warn_nosemi);
+   CopLINE_inc(PL_curcop);
+   }
+   else
+   /* We want to call no_op with s pointing after the
+  bareword, so defer it.  But we want it to come
+  before the Bad name croak.  */
+   no_op_error = TRUE;
+   }
 
/* Get the rest if it looks like a package qualifier */
 
@@ -7274,6 +7287,10 @@ Perl_yylex(pTHX)
STRLEN morelen;
s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - 
len,
  TRUE, );
+   if (no_op_error) {
+   no_op("Bareword",s);
+   no_op_error = FALSE;
+   }
if (!morelen)
Perl_croak(aTHX_ "Bad name after %" UTF8f "%s",
UTF8fARG(UTF, len, PL_tokenbuf),
@@ -7282,15 +7299,8 @@ Perl_yylex(pTHX)
pkgname = 1;
}
 
-   if (PL_expect == XOPERATOR) {
-   if (PL_bufptr == PL_linestart) {
-   CopLINE_dec(PL_curcop);
-   Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", 
PL_warn_nosemi);
-   CopLINE_inc(PL_curcop);
-   }
-   else
+   if (no_op_error)
no_op("Bareword",s);
-   }
 
/* See if the name is "Foo::",
   in which case 

[perl.git] branch smoke-me/khw-variant created. v5.27.6-121-g660e06474d

[Karl Williamson]

In perl.git, the branch smoke-me/khw-variant has been created



at  660e06474df961abac1b2c35aeccdd1557cf6937 (commit)

- Log -
commit 660e06474df961abac1b2c35aeccdd1557cf6937
Author: Karl Williamson 
Date:   Wed Nov 22 22:30:16 2017 -0700

Add variant_under_utf8_count() core function

This function takes a string that isn't encoded in UTF-8 (hence is
assumed to be in Latin1), and counts how many of the bytes therein
would change if it were to be translated into UTF-8.  Each such byte
will occupy two UTF-8 bytes.

This function is useful for calculating the expansion factor precisely
when converting to UTF-8, so as to know how much to malloc.

This function uses a non-obvious method to do the calculations
word-at-a-time, as opposed to the byte-at-a-time method used now, and
hence should be much faster than the current methods.  And, in fact the
comparison below shows that the new method uses 1/8 the conditionals and
1/8 of the reads that the old one did on a platform with 64-bit words.

 byte   word
   -- --
Ir 100.00 363.49
Dr 100.00 798.48
Dw 100.00 102.22
  COND 100.00 799.38
   IND 100.00 100.00

COND_m 100.00 100.00
 IND_m 100.00 100.00

 Ir_m1 100.00 100.00
 Dr_m1 100.00 100.00
 Dw_m1 100.00 100.00

 Ir_mm 100.00 100.00
 Dr_mm 100.00 100.00
 Dw_mm 100.00 100.00

I found this trick on the internet many years ago, but I can't seem to
find it again to give them credit.

---

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/jkeenan/d_uselocale-freebsd deleted. v5.27.6-95-g4029efe963

[James Keenan]

In perl.git, the branch smoke-me/jkeenan/d_uselocale-freebsd has been deleted



   was  4029efe96337bef788568948c9322198910bf446

- Log -
4029efe96337bef788568948c9322198910bf446 Use userland version of OS in test, 
rather than kernel version.
---

-- 
Perl5 Master Repository

[perl.git] branch blead updated. v5.27.6-121-g304cc305d1

[James Keenan]

In perl.git, the branch blead has been updated



- Log -
commit 304cc305d1f9c22eaa9ccfed1d472022f8bb82b8
Author: James E Keenan 
Date:   Tue Nov 28 22:07:18 2017 -0500

Relax workaround for d_uselocale from RT #128867.

More precisely, tailor the application of the workaround to the FreeBSD
userland version ranges specified in
https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=211743#c10.  (Using
userland version ('uname -U') rather than kernel version ('uname -K') at
suggestion of Mathieu Arnold.

We probably don't need an 'else' branch; let Configure handle it.

---

Summary of changes:
 hints/freebsd.sh | 16 ++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/hints/freebsd.sh b/hints/freebsd.sh
index b3422c9ecc..5d69dee0eb 100644
--- a/hints/freebsd.sh
+++ b/hints/freebsd.sh
@@ -318,8 +318,20 @@ esac
 # of FreeBSD.
 d_printf_format_null='undef'
 
-# As of 10.3-RELEASE FreeBSD.  See [perl #128867]
-d_uselocale='undef'
+# See [perl #128867]
+# Interpreting: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=211743#c10
+# khw workaround no longer needed in the following FREEBSD_KERNEL_VERSIONs
+#124 and up
+#1100502 >= version < 120
+#1003507 >= version < 110
+
+FREEBSD_KERNEL_VERSION=`uname -U`
+if  [ $FREEBSD_KERNEL_VERSION -lt 1003507 ] || \
+[ $FREEBSD_KERNEL_VERSION -ge 110 ] && [ $FREEBSD_KERNEL_VERSION -lt 
1100502 ] || \
+[ $FREEBSD_KERNEL_VERSION -ge 120 ] && [ $FREEBSD_KERNEL_VERSION -lt 
124 ]
+then
+d_uselocale='undef'
+fi
 
 # https://rt.perl.org/Ticket/Display.html?id=131337
 # Reported in 11.0-CURRENT with g++-4.8.5:

-- 
Perl5 Master Repository

[perl.git] branch smoke-me/ilmari/arybasectomy updated. v5.27.6-117-g5874577a26

[Dagfinn Ilmari Mannsåker]

In perl.git, the branch smoke-me/ilmari/arybasectomy has been updated



  discards  792288f86a1b444a75af4a74e7106639d06994ac (commit)
- Log -
commit 5874577a262c2e35633865be5997bba6ad87de03
Author: Dagfinn Ilmari Mannsåker 
Date:   Mon Dec 4 11:27:57 2017 +

Remove arybase support from B::Deparse

commit 88b354cf9504deebb0b35d4698e0b25e5278ca5a
Author: Dagfinn Ilmari Mannsåker 
Date:   Wed Oct 18 01:01:11 2017 +0100

Remove support for setting $[ to a non-zero value

This removes arybase and all its surrounding machinery.

---

Summary of changes:
 MANIFEST  |  1 +
 lib/B/Deparse.pm  | 31 +--
 lib/feature.pm|  6 ++
 regen/feature.pl  |  8 
 t/lib/feature/removed | 10 ++
 5 files changed, 30 insertions(+), 26 deletions(-)
 create mode 100644 t/lib/feature/removed

diff --git a/MANIFEST b/MANIFEST
index 410a1cc4d5..fd43598007 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5456,6 +5456,7 @@ t/lib/Devel/switchd_goto.pm   Module for 
t/run/switchd.t
 t/lib/feature/bundle   Tests for feature bundles
 t/lib/feature/implicit Tests for implicit loading of feature.pm
 t/lib/feature/nonesuch Tests for enabling/disabling nonexistent feature
+t/lib/feature/removed  Tests for enabling/disabling removed feature
 t/lib/feature/say  Tests for enabling/disabling say feature
 t/lib/feature/switch   Tests for enabling/disabling switch feature
 t/lib/h2ph.h   Test header file for h2ph
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 552798de07..8a26aae06f 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -52,7 +52,7 @@ use B qw(class main_root main_start main_cv svref_2object 
opnumber perlstring
 MDEREF_SHIFT
 );
 
-$VERSION = '1.46';
+$VERSION = '1.47';
 use strict;
 our $AUTOLOAD;
 use warnings ();
@@ -66,7 +66,7 @@ BEGIN {
OPpPAD_STATE PMf_SKIPWHITE RXf_SKIPWHITE
PMf_CHARSET PMf_KEEPCOPY PMf_NOCAPTURE CVf_ANONCONST
CVf_LOCKED OPpREVERSE_INPLACE OPpSUBSTR_REPL_FIRST
-   PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES
+   PMf_NONDESTRUCT OPpEVAL_BYTES
OPpLVREF_TYPE OPpLVREF_SV OPpLVREF_AV OPpLVREF_HV
OPpLVREF_CV OPpLVREF_ELEM SVpad_STATE)) {
eval { B->import($_) };
@@ -789,7 +789,6 @@ sub new {
 $self->{'use_dumper'} = 0;
 $self->{'use_tabs'} = 0;
 
-$self->{'ambient_arybase'} = 0;
 $self->{'ambient_warnings'} = undef; # Assume no lexical warnings
 $self->{'ambient_hints'} = 0;
 $self->{'ambient_hinthash'} = undef;
@@ -835,7 +834,6 @@ sub new {
 sub init {
 my $self = shift;
 
-$self->{'arybase'}  = $self->{'ambient_arybase'};
 $self->{'warnings'} = defined ($self->{'ambient_warnings'})
? $self->{'ambient_warnings'} & WARN_MASK
: undef;
@@ -951,7 +949,7 @@ my %strict_bits = do {
 
 sub ambient_pragmas {
 my $self = shift;
-my ($arybase, $hint_bits, $warning_bits, $hinthash) = (0, 0);
+my ($hint_bits, $warning_bits, $hinthash) = (0);
 
 while (@_ > 1) {
my $name = shift();
@@ -978,14 +976,6 @@ sub ambient_pragmas {
$hint_bits |= $strict_bits{$_} for @names;
}
 
-   elsif ($name eq '$[') {
-   if (OPpCONST_ARYBASE) {
-   $arybase = $val;
-   } else {
-   croak "\$[ can't be non-zero on this perl" unless $val == 0;
-   }
-   }
-
elsif ($name eq 'integer'
|| $name eq 'bytes'
|| $name eq 'utf8') {
@@ -1056,7 +1046,6 @@ sub ambient_pragmas {
croak "The ambient_pragmas method expects an even number of args";
 }
 
-$self->{'ambient_arybase'} = $arybase;
 $self->{'ambient_warnings'} = $warning_bits;
 $self->{'ambient_hints'} = $hint_bits;
 $self->{'ambient_hinthash'} = $hinthash;
@@ -2037,11 +2026,6 @@ sub pragmata {
$self->{'curstash'} = $stash;
 }
 
-if (OPpCONST_ARYBASE && $self->{'arybase'} != $op->arybase) {
-   push @text, '$[ = '. $op->arybase .";\n";
-   $self->{'arybase'} = $op->arybase;
-}
-
 my $warnings = $op->warnings;
 my $warning_bits;
 if ($warnings->isa("B::SPECIAL") && $$warnings == 4) {
@@ -4114,7 +4098,7 @@ sub pp_aelemfast_lex {
 $name =~ s/^@/\$/;
 my $i = $op->private;
 $i -= 256 if $i > 127;
-return $name . "[" .  ($i + $self->{'arybase'}) . "]";
+return $name . "[$i]";
 }
 
 sub pp_aelemfast {
@@ -4128,7 +4112,7 @@ sub pp_aelemfast {
 $name = $quoted ? "$name->" : '$' . $name;
 my $i = 

[perl.git] branch smoke-me/jkeenan/d_uselocale-freebsd updated. v5.27.6-95-g4029efe963

[James Keenan]

In perl.git, the branch smoke-me/jkeenan/d_uselocale-freebsd has been updated



  discards  0b01da81b002a8524363124f2ebf8542afb70505 (commit)
  discards  2ce94a867b15d96bd49eb8807d39df950f3a1087 (commit)
  discards  4f193c3e96af4b9697510e396fb5e944776d38fb (commit)
  discards  0649b6e4b934675951c7e1419db9284578a54496 (commit)
  discards  833d07d41793fe678f93433fca9520ec1a22f750 (commit)
  discards  44626bc98dce9dce5689298504e30ed86a7e0a0a (commit)
  discards  8779d80ae74c415b57b9d139bb415e167292cd2a (commit)
  discards  349ac40cfe6901fb2054c054b3fe3388bebde35d (commit)
  discards  9607fbb7cdfce88351b3ca3fcc5d4c96e616da63 (commit)
  discards  9d875cfd2b113b3cb1462875c8b92f3f08859fb5 (commit)
  discards  abda9fe0fe75ae824723761c1c98af958f17a41c (commit)
  discards  3c67ad9b9e6d659feb76f3acfc9f81cfe59e3660 (commit)
  discards  7b9d2ba3d09352167d77ea97c7857509f147ef49 (commit)
  discards  009165e9970c3fcc3a252874e1ed96b1733976ea (commit)
  discards  64072da0d64f4e24d5d3f53f391a1fb7a5121ac0 (commit)
  discards  21baa9a2e2a9246add77c46706383cc1ccb9 (commit)
  discards  b9ed226ea83c3e6793242859ed66a48c851a6872 (commit)
  discards  0ab6e880393a97aa9a4748ff7169e2fe3c6cd82e (commit)
  discards  f3651218fa1e8bce8ea0dd4c0ffbb63cd82aea22 (commit)
  discards  7fdcbfeb6ff2c7b15dffdedc4218e4a0803b28b5 (commit)
  discards  8fb542fb61a07463a6c7d43ea17e35ecb0d407f6 (commit)
  discards  c4880455a025944bb5d97b712f6eafd21810a711 (commit)
  discards  3edba68397e487b39cca6e7fc0b75ab4a2f6a341 (commit)
  discards  b6806da1b6a1684b26f8ef5b7f2ca4133d468604 (commit)
  discards  c1c824fc91d679abcbe5f72252ac95924474a9e4 (commit)
- Log -
commit 4029efe96337bef788568948c9322198910bf446
Author: James E Keenan 
Date:   Mon Dec 4 07:53:47 2017 -0500

Use userland version of OS in test, rather than kernel version.

Per review by Mathieu Arnold.

commit 7654f0da005e5d7922f57aa3d5f45ceacdc10165
Author: James E Keenan 
Date:   Tue Nov 28 22:07:18 2017 -0500

Relax workaround for d_uselocale from RT #128867.

More precisely, tailor the application of the workaround to the FreeBSD 
kernel
version ranges specified in
https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=211743#c10.

We probably don't need an 'else' branch; let Configure handle it.

---

Summary of changes:
 Porting/Maintainers.pl|   2 +-
 charclass_invlists.h  |   2 +-
 configure.com |   2 -
 cpan/File-Fetch/lib/File/Fetch.pm |   4 +-
 dist/Data-Dumper/Dumper.pm|   8 +--
 dist/Data-Dumper/Dumper.xs|  22 --
 dist/Data-Dumper/t/dumper.t   |  35 +-
 doio.c|   7 +-
 handy.h   |   8 +--
 hints/freebsd.sh  |   2 +-
 lib/unicore/mktables  | 137 --
 malloc.c  |  12 ++--
 op.c  |   5 +-
 pod/perldelta.pod |   5 --
 pod/perlhack.pod  |   3 -
 pp_sys.c  |   9 +--
 regcharclass.h|   2 +-
 regcomp.c |  16 -
 regexec.c |  17 ++---
 t/lib/warnings/9enabled   |   3 +-
 t/op/substr.t |  11 +--
 t/re/re_tests |   1 -
 t/run/switches.t  |   2 +-
 zaphod32_hash.h   |   5 +-
 24 files changed, 93 insertions(+), 227 deletions(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 7048381e80..2ed349e2e3 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -489,7 +489,7 @@ use File::Glob qw(:case);
 },
 
 'File::Fetch' => {
-'DISTRIBUTION' => 'BINGOS/File-Fetch-0.56.tar.gz',
+'DISTRIBUTION' => 'BINGOS/File-Fetch-0.54.tar.gz',
 'FILES'=> q[cpan/File-Fetch],
 },
 
diff --git a/charclass_invlists.h b/charclass_invlists.h
index 5370b11479..841820512c 100644
--- a/charclass_invlists.h
+++ b/charclass_invlists.h
@@ -97454,7 +97454,7 @@ static const U8 WB_table[24][24] = {
  * be0f129691d479aa38646e4ca0ec1ee576ae7f75b0300a5624a7fa862fa8abba 
lib/unicore/extracted/DLineBreak.txt
  * 92449d354d9f6b6f2f97a292ebb59f6344ffdeb83d120d7d23e569c43ba67cd5 
lib/unicore/extracted/DNumType.txt
  * e3a319527153b0c6c0c549b40fc6f3a01a7a0dcd6620784391db25901df3b154 
lib/unicore/extracted/DNumValues.txt
- * 54674ddca5d34b6e08b881e39573d821079cc552fc57e811f6da121bed59a3f8 
lib/unicore/mktables
+ * 7e82d9210fb1c8ffadda5a3a04912fc34a165bfe98ac80c1669c1e67c3de044a 
lib/unicore/mktables
  * 21653d2744fdd071f9ef138c805393901bb9547cf3e777ebf50215a191f986ea 
lib/unicore/version
  * 

[perl.git] branch blead updated. v5.27.6-120-gbcc30fd027

[Dave Mitchell]

In perl.git, the branch blead has been updated



- Log -
commit bcc30fd0276e8f6d4ac27d6f4c719b70a266b1fc
Author: David Mitchell 
Date:   Mon Dec 4 11:50:53 2017 +

multiconcat: don't fold adjacent constants

RT #132385

In something like

$overloaded . "a" . "b"

perl used to do

$overloaded->concat("a")->concat("b")

but since the introduction of OP_MULTICONCAT, started doing:

$overloaded->concat("ab")

This commit restores the old behaviour, by keeping every second adjacent
OP_CONST as an arg rather than optimising it away and adding its contents
to the constant string in the aux struct.

But note that

$overloaded .=  "a" . "b"

originally, and still, constant folds.

---

Summary of changes:
 lib/overload.t   | 11 +--
 op.c | 27 +++
 t/perf/opcount.t | 31 ++-
 3 files changed, 66 insertions(+), 3 deletions(-)

diff --git a/lib/overload.t b/lib/overload.t
index 75a7aa2b32..2afa6cf437 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl'; require './charset_tools.pl' }
-plan tests => 5332;
+plan tests => 5338;
 
 use Scalar::Util qw(tainted);
 
@@ -2891,7 +2891,7 @@ package Concat {
 my ($r, $R);
 
 
-# like c, but with $is_ref set to 1
+# like cc, but with $is_ref set to 1
 sub c {
 my ($expr, $expect, $exp_id) = @_;
 cc($expr, $expect, 1, $exp_id);
@@ -2994,6 +2994,13 @@ package Concat {
 cc '$r.=sprintf("%s%s%s",$a,$B,$c)', 'raBc', 0, '("",[B],u,)';
 cc '$R.=sprintf("%s%s%s",$a,$B,$c)', 'RaBc', 1, '("",[B],u,)(.=,[R],aBc,u)'
.'("",[RaBc],u,)';
+
+# multiple constants should individually overload (RT #132385)
+
+c '$r=$A."b"."c"', 'Abc',  '(.,[A],b,)(.=,[Ab],c,u)("",[Abc],u,)';
+
+# ... except for this
+c '$R.="a"."b"',   'Rab',  '(.=,[R],ab,u)("",[Rab],u,)';
 }
 
 # RT #132385
diff --git a/op.c b/op.c
index 7030af0778..7d0185f650 100644
--- a/op.c
+++ b/op.c
@@ -2933,6 +2933,33 @@ S_maybe_multiconcat(pTHX_ OP *o)
 if (stacked_last)
 return; /* we don't support ((A.=B).=C)...) */
 
+/* look for two adjacent consts and don't fold them together:
+ * $o . "a" . "b"
+ * should do
+ * $o->concat("a")->concat("b")
+ * rather than
+ * $o->concat("ab")
+ * (but $o .=  "a" . "b" should still fold)
+ */
+{
+bool seen_nonconst = FALSE;
+for (argp = toparg; argp >= args; argp--) {
+if (argp->p == NULL) {
+seen_nonconst = TRUE;
+continue;
+}
+if (!seen_nonconst)
+continue;
+if (argp[1].p) {
+/* both previous and current arg were constants;
+ * leave the current OP_CONST as-is */
+argp->p = NULL;
+nconst--;
+nargs++;
+}
+}
+}
+
 /* -
  * Phase 2:
  *
diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index 0ded6cd360..2d0ade56b0 100644
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -20,7 +20,7 @@ BEGIN {
 use warnings;
 use strict;
 
-plan 2579;
+plan 2582;
 
 use B ();
 
@@ -634,3 +634,32 @@ test_opcount(0, "state works with multiconcat",
 once=> 1,
 padsv   => 2, # one each for the next/once branches
 });
+
+# multiple concats of constants preceded by at least one non-constant
+# shouldn't get constant-folded so that a concat overload method is called
+# for each arg. So every second constant string is left as an OP_CONST
+
+test_opcount(0, "multiconcat: 2 adjacent consts",
+sub { my ($a, $b); $a = $b . "c" . "d" },
+{
+const   => 1,
+multiconcat => 1,
+concat  => 0,
+sassign => 0,
+});
+test_opcount(0, "multiconcat: 3 adjacent consts",
+sub { my ($a, $b); $a = $b . "c" . "d" . "e" },
+{
+const   => 1,
+multiconcat => 1,
+concat  => 0,
+sassign => 0,
+});
+test_opcount(0, "multiconcat: 4 adjacent consts",
+sub { my ($a, $b); $a = $b . "c" . "d" . "e" ."f" },
+{
+const   => 2,
+multiconcat => 1,
+