From: David Mitchell 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;