This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #122029] BBC KAWASAKI/Encode-JP-Emoji
authorKarl Williamson <khw@cpan.org>
Mon, 16 Jun 2014 18:28:52 +0000 (12:28 -0600)
committerKarl Williamson <khw@cpan.org>
Mon, 16 Jun 2014 18:46:24 +0000 (12:46 -0600)
This turns out to be that the code was only getting the compile-time
package name, and it needs to be expanded to get the correct run-time
name.

regcomp.c
t/re/pat_advanced.t

index 76c823b..57c5cbb 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -13610,6 +13610,9 @@ parseit:
                                              &swash_init_flags
                                             );
                     if (! swash || ! (invlist = _get_swash_invlist(swash))) {
+                        HV* curpkg = (IN_PERL_COMPILETIME)
+                                      ? PL_curstash
+                                      : CopSTASH(PL_curcop);
                         if (swash) {
                             SvREFCNT_dec_NN(swash);
                             swash = NULL;
@@ -13629,14 +13632,17 @@ parseit:
                         /* If the property name doesn't already have a package
                          * name, add the current one to it so that it can be
                          * referred to outside it. [perl #121777] */
-                        if (! instr(name, "::") && PL_curstash) {
+                        if (curpkg && ! instr(name, "::")) {
+                            char* pkgname = HvNAME(curpkg);
+                            if (strNE(pkgname, "main")) {
                             char* full_name = Perl_form(aTHX_
                                                         "%s::%s",
-                                                        HvNAME(PL_curstash),
+                                                        pkgname,
                                                         name);
                             n = strlen(full_name);
                             Safefree(name);
                             name = savepvn(full_name, n);
+                            }
                         }
                         Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%"UTF8f"\n",
                                         (value == 'p' ? '+' : '!'),
index 5ca7159..d6d14df 100644 (file)
@@ -2316,6 +2316,10 @@ EOP
         }
 
         like('q', $regex, 'User-defined property matches outside package');
+
+        package Some {
+            main::like('abcq', qr/abc$regex/, 'Run-time compiled in-package user-defined property matches');
+        }
     }
 
     {   # From Lingua::Stem::UniNE; no ticket filed but related to #121778