Integrate:

[ 22582]
mintest will pass if I skip the correct number of tests. D'oh!

[ 22591]
[perl #27268] Blessed reference to anonymous glob
Stop *$$x=$x giving "Attempt to free unreferenced scalar" warning

[ 22594]
 [perl #27040] - hints hash was being double freed on scope exit

[ 22596]
fix for change #22594; if using test.pl, must tell perl where to
find it!

[ 22599]
[perl #24200] string corruption with lvalue sub
Depending on the context, the same substr OP may want to return
a PVLV or an LV on subsequent invcations. If TARG is the wrong
type, use a mortal instead.

[ 22605]
pv_display() had code to display \n etc as escapes but it didn't
actually work.

[ 22607]
update -Dx to cope with lexical version of OP_AELEMFAST
p4raw-link: @22607 on //depot/perl: 38c076c778be4d77b58837d5c13b55bd2f5fb50e
p4raw-link: @22605 on //depot/perl: 46316b0a1e18bbab306c955d1ad4c7942f675812
p4raw-link: @22599 on //depot/perl: 781e754729fc501417aaa89f25dc83f904a17c5c
p4raw-link: @22596 on //depot/perl: 0f94e4a979939cb2b1eeb2199cf16a3fe85e8ddb
p4raw-link: @22594 on //depot/perl: dfa41748806263fb8b5d5fcb051bd36be96fe93c
p4raw-link: @22591 on //depot/perl: ec5f3c78a7539e41900be465ef86bff34f621939
p4raw-link: @22582 on //depot/perl: 13b238e638f82ea9dd82406b41b94ea2b72b1275

p4raw-id: //depot/maint-5.8/perl@22622
p4raw-edited: from //depot/perl@22620 'edit in' t/op/substr.t
	(@22419..)
p4raw-integrated: from //depot/perl@22620 'copy in' t/op/ref.t
	(@19849..) t/op/magic.t (@22564..) t/comp/hints.t (@22594..)
	'edit in' dump.c (@22605..) 'merge in' scope.h (@22509..) op.c
	(@22520..) sv.c (@22546..) pp.c (@22549..) scope.c (@22578..)

10 files changed, 95 insertions, 41 deletions

diff --git a/dump.c b/dump.c
index b19006efc3..645e34f0ae 100644
--- a/dump.c
+++ b/dump.c
@@ -116,19 +116,17 @@ Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
             truncated++;
 	    break;
         }
-        if (isPRINT(*pv)) {
-            switch (*pv) {
-	    case '\t': sv_catpvn(dsv, "\\t", 2);  break;
-	    case '\n': sv_catpvn(dsv, "\\n", 2);  break;
-	    case '\r': sv_catpvn(dsv, "\\r", 2);  break;
-	    case '\f': sv_catpvn(dsv, "\\f", 2);  break;
-	    case '"':  sv_catpvn(dsv, "\\\"", 2); break;
-	    case '\\': sv_catpvn(dsv, "\\\\", 2); break;
-	    default:   sv_catpvn(dsv, pv, 1);     break;
-            }
-        }
-	else {
-	    if (cur && isDIGIT(*(pv+1)))
+	switch (*pv) {
+	case '\t': sv_catpvn(dsv, "\\t", 2);  break;
+	case '\n': sv_catpvn(dsv, "\\n", 2);  break;
+	case '\r': sv_catpvn(dsv, "\\r", 2);  break;
+	case '\f': sv_catpvn(dsv, "\\f", 2);  break;
+	case '"':  sv_catpvn(dsv, "\\\"", 2); break;
+	case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+	default:
+	    if (isPRINT(*pv))
+		sv_catpvn(dsv, pv, 1);
+	    else if (cur && isDIGIT(*(pv+1)))
 		Perl_sv_catpvf(aTHX_ dsv, "\\%03o", (U8)*pv);
 	    else
 		Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
@@ -644,17 +642,19 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 #ifdef USE_ITHREADS
 	Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
 #else
-	if (cSVOPo->op_sv) {
-	    SV *tmpsv = NEWSV(0,0);
-	    STRLEN n_a;
-	    ENTER;
-	    SAVEFREESV(tmpsv);
-	    gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
-	    Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
-	    LEAVE;
+	if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
+	    if (cSVOPo->op_sv) {
+		SV *tmpsv = NEWSV(0,0);
+		STRLEN n_a;
+		ENTER;
+		SAVEFREESV(tmpsv);
+		gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
+		Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
+		LEAVE;
+	    }
+	    else
+		Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
 	}
-	else
-	    Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
 #endif
 	break;
     case OP_CONST:
diff --git a/op.c b/op.c
index 27acd78553..e57933e73b 100644
--- a/op.c
+++ b/op.c
@@ -1809,13 +1809,11 @@ Perl_scope(pTHX_ OP *o)
     return o;
 }
 
+/* XXX kept for BINCOMPAT only */
 void
 Perl_save_hints(pTHX)
 {
-    SAVEI32(PL_hints);
-    SAVESPTR(GvHV(PL_hintgv));
-    GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
-    SAVEFREESV(GvHV(PL_hintgv));
+    Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
 }
 
 int
diff --git a/pp.c b/pp.c
index 3b0f99b1a6..0137bf16cb 100644
--- a/pp.c
+++ b/pp.c
@@ -3025,6 +3025,19 @@ PP(pp_substr)
 	if (utf8_curlen)
 	    sv_pos_u2b(sv, &pos, &rem);
 	tmps += pos;
+	/* we either return a PV or an LV. If the TARG hasn't been used
+	 * before, or is of that type, reuse it; otherwise use a mortal
+	 * instead. Note that LVs can have an extended lifetime, so also
+	 * dont reuse if refcount > 1 (bug #20933) */
+	if (SvTYPE(TARG) > SVt_NULL) {
+	    if ( (SvTYPE(TARG) == SVt_PVLV)
+		    ? (!lvalue || SvREFCNT(TARG) > 1)
+		    : lvalue)
+	    {
+		TARG = sv_newmortal();
+	    }
+	}
+
 	sv_setpvn(TARG, tmps, rem);
 #ifdef USE_LOCALE_COLLATE
 	sv_unmagic(TARG, PERL_MAGIC_collxfrm);
@@ -3061,8 +3074,6 @@ PP(pp_substr)
 		    sv_setpvn(sv,"",0);	/* avoid lexical reincarnation */
 	    }
 
-	    if (SvREFCNT(TARG) > 1)	/* don't share the TARG (#20933) */
-		TARG = sv_newmortal();
 	    if (SvTYPE(TARG) < SVt_PVLV) {
 		sv_upgrade(TARG, SVt_PVLV);
 		sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
diff --git a/scope.c b/scope.c
index 8bcb1b2716..c1cbcc3466 100644
--- a/scope.c
+++ b/scope.c
@@ -1017,6 +1017,11 @@ Perl_leave_scope(pTHX_ I32 base)
 		GvHV(PL_hintgv) = NULL;
 	    }
 	    *(I32*)&PL_hints = (I32)SSPOPINT;
+	    if (PL_hints & HINT_LOCALIZE_HH) {
+		SvREFCNT_dec((SV*)GvHV(PL_hintgv));
+		GvHV(PL_hintgv) = (HV*)SSPOPPTR;
+	    }
+		    
 	    break;
 	case SAVEt_COMPPAD:
 	    PL_comppad = (PAD*)SSPOPPTR;
diff --git a/scope.h b/scope.h
index 24948cbb6a..612de4aa14 100644
--- a/scope.h
+++ b/scope.h
@@ -150,14 +150,14 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVEOP()	save_op()
 
 #define SAVEHINTS() \
-    STMT_START {				\
-	if (PL_hints & HINT_LOCALIZE_HH)	\
-	    save_hints();			\
-	else {					\
-	    SSCHECK(2);				\
-	    SSPUSHINT(PL_hints);		\
-	    SSPUSHINT(SAVEt_HINTS);		\
-	}					\
+    STMT_START {					\
+	SSCHECK(3);					\
+	if (PL_hints & HINT_LOCALIZE_HH) {		\
+	    SSPUSHPTR(GvHV(PL_hintgv));			\
+	    GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));	\
+	}						\
+	SSPUSHINT(PL_hints);				\
+	SSPUSHINT(SAVEt_HINTS);				\
     } STMT_END
 
 #define SAVECOMPPAD() \
diff --git a/sv.c b/sv.c
index 275e1a918d..e66a9f7695 100644
--- a/sv.c
+++ b/sv.c
@@ -403,6 +403,7 @@ do_clean_named_objs(pTHX_ SV *sv)
 	     (GvCV(sv) && SvOBJECT(GvCV(sv))) )
 	{
 	    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
+	    SvFLAGS(sv) |= SVf_BREAK;
 	    SvREFCNT_dec(sv);
 	}
     }
diff --git a/t/comp/hints.t b/t/comp/hints.t
index 117096860f..f00bb6a893 100644
--- a/t/comp/hints.t
+++ b/t/comp/hints.t
@@ -2,7 +2,13 @@
 
 # Tests the scoping of $^H and %^H
 
-BEGIN { print "1..14\n"; }
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
+}
+
+
+BEGIN { print "1..15\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
@@ -55,3 +61,15 @@ BEGIN {
     print "not " if $^H & 0x00020000;
     print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
 }
+
+require 'test.pl';
+
+# bug #27040: hints hash was being double-freed
+my $result = runperl(
+    prog => '$^H |= 0x20000; eval q{BEGIN { $^H |= 0x20000 }}',
+    stderr => 1
+);
+print "not " if length $result;
+print "ok 15 - double-freeing hints hash\n";
+print "# got: $result\n" if length $result;
+
diff --git a/t/op/magic.t b/t/op/magic.t
index dda07dfbc9..1c02b5bbad 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -349,7 +349,7 @@ else {
 }
 
 if ($Is_miniperl) {
-    skip ("miniperl can't rely on loading %Errno");
+    skip ("miniperl can't rely on loading %Errno") for 1..2;
 } else {
    no warnings 'void';
 
diff --git a/t/op/ref.t b/t/op/ref.t
index 3bb280c1ea..597e03698c 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..68\n";
+print "1..69\n";
 
 require 'test.pl';
 
@@ -357,6 +357,16 @@ runperl(prog => 'sub f { my $x = shift; *z = $x; } f({}); f();');
 if ($? != 0) { print "not " };
 print "ok ",++$test," - coredump on typeglob = (SvRV && !SvROK)\n";
 
+# bug #27268: freeing self-referential typeglobs could trigger
+# "Attempt to free unreferenced scalar" warnings
+
+$result = runperl(
+    prog => 'use Symbol;my $x=bless \gensym,"t"; print;*$$x=$x',
+    stderr => 1
+);
+print "not " if length $result;
+print "ok ",++$test," - freeing self-referential typeglob\n";
+print "# got: $result\n" if length $result;
 
 # test global destruction
 
diff --git a/t/op/substr.t b/t/op/substr.t
index dfb483aee5..4df6426388 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..177\n";
+print "1..179\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
@@ -609,3 +609,14 @@ ok 174, $x eq "\x{100}\x{200}\xFFb";
     my $y = substr $x, 4;
     ok 177, substr($x, 7, 1) eq "7";
 }
+
+# [perl #24200] string corruption with lvalue sub
+
+{
+    my $foo = "a";
+    sub bar: lvalue { substr $foo, 0 }
+    bar = "XXX";
+    ok 178, bar eq 'XXX';
+    $foo = '123456789';
+    ok 179, bar eq '123456789';
+}