From: David Mitchell <davem@iabyn.com>
Date: Tue, 2 Mar 2010 20:39:28 +0000 (+0000)
Subject: [perl #73174] swash_init() wasn't saving %^H
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ec34a119;p=p5sagit%2Fp5-mst-13.2.git

[perl #73174] swash_init() wasn't saving %^H
---

diff --git a/lib/charnames.t b/lib/charnames.t
index f74453d..50c23f3 100644
--- a/lib/charnames.t
+++ b/lib/charnames.t
@@ -15,7 +15,7 @@ require File::Spec;
 
 $| = 1;
 
-print "1..79\n";
+print "1..80\n";
 
 use charnames ':full';
 
@@ -342,6 +342,23 @@ if ($@) {
 print "not " unless "\N{U+1D0C5}" eq "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}";
 print "ok 79\n";
 
+# [perl #73174] use of \N{FOO} used to reset %^H
+
+{
+    use charnames ":full";
+    my $res;
+    BEGIN { $^H{73174} = "foo" }
+    BEGIN { $res = ($^H{73174} // "") }
+    # forces loading of utf8.pm, which used to reset %^H
+    $res .= '-1' if ":" =~ /\N{COLON}/i;
+    BEGIN { $res .= '-' . ($^H{73174} // "") }
+    $res .= '-' . ($^H{73174} // "");
+    $res .= '-2' if ":" =~ /\N{COLON}/;
+    $res .= '-3' if ":" =~ /\N{COLON}/i;
+    print $res eq "foo-foo-1--2-3" ? "" : "not ",
+	"ok 80 - \$^H{foo} correct after /\\N{bar}/i (res=$res)\n";
+}
+
 __END__
 # unsupported pragma
 use charnames ":scoobydoo";
diff --git a/t/comp/hints.t b/t/comp/hints.t
index f8c6dca..9f40aec 100644
--- a/t/comp/hints.t
+++ b/t/comp/hints.t
@@ -4,7 +4,7 @@
 
 @INC = '../lib';
 
-BEGIN { print "1..23\n"; }
+BEGIN { print "1..24\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
@@ -109,6 +109,21 @@ BEGIN {
     print +($rf2 eq "z" ? "" : "not "), "ok 22 - \$^H{foo} correct after require\n";
 }
 
+# [perl #73174]
+
+{
+    my $res;
+    BEGIN { $^H{73174} = "foo" }
+    BEGIN { $res = ($^H{73174} // "") }
+    "" =~ /\x{100}/i;	# forces loading of utf8.pm, which used to reset %^H
+    BEGIN { $res .= '-' . ($^H{73174} // "")}
+    $res .= '-' . ($^H{73174} // "");
+    print $res eq "foo-foo-" ? "" : "not ",
+	"ok 23 - \$^H{foo} correct after /unicode/i (res=$res)\n";
+}
+
+
+
 # Add new tests above this require, in case it fails.
 require './test.pl';
 
@@ -118,7 +133,7 @@ my $result = runperl(
     stderr => 1
 );
 print "not " if length $result;
-print "ok 23 - double-freeing hints hash\n";
+print "ok 24 - double-freeing hints hash\n";
 print "# got: $result\n" if length $result;
 
 __END__
diff --git a/utf8.c b/utf8.c
index 040b273..9ed0663 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1842,8 +1842,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
 
     PUSHSTACKi(PERLSI_MAGIC);
     ENTER;
-    SAVEI32(PL_hints);
-    PL_hints = 0;
+    SAVEHINTS();
     save_re_context();
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {	/* demand load utf8 */
 	ENTER;