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

diff --git a/lib/charnames.t b/lib/charnames.t
index f74453d..50c23f3 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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;