This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update AUTHORS file and convert from Latin-1 to UTF-8
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 3c46fc3..ca94935 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -219,7 +219,15 @@ PP(pp_rv2gv)
                       things.  */
                    RETURN;
                }
-               sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV));
+               {
+                   STRLEN len;
+                   const char * const nambeg = SvPV_nomg_const(sv, len);
+                   sv = MUTABLE_SV(
+                       gv_fetchpvn_flags(
+                           nambeg, len, GV_ADD | SvUTF8(sv), SVt_PVGV
+                       )
+                   );
+               }
            }
            /* FAKE globs in the symbol table cause weird bugs (#77810) */
            if (sv) SvFAKE_off(sv);
@@ -281,7 +289,9 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
                }
        }
     else {
-       gv = gv_fetchsv(sv, GV_ADD, type);
+       STRLEN len;
+       const char * const nambeg = SvPV_nomg_const(sv, len);
+       gv = gv_fetchpvn_flags(nambeg, len, GV_ADD | SvUTF8(sv), type);
     }
     return gv;
 }
@@ -429,89 +439,13 @@ PP(pp_prototype)
        const char * s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
-           if (code < 0) {     /* Overridable. */
-#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
-               int i = 0, n = 0, seen_question = 0, defgv = 0;
-               I32 oa;
-               char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
-
-               if (code == -KEY_chop || code == -KEY_chomp
-                       || code == -KEY_exec || code == -KEY_system)
-                   goto set;
-               if (code == -KEY_mkdir) {
-                   ret = newSVpvs_flags("_;$", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
-                   ret = newSVpvs_flags("+", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_push || code == -KEY_unshift) {
-                   ret = newSVpvs_flags("+@", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_pop || code == -KEY_shift) {
-                   ret = newSVpvs_flags(";+", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_splice) {
-                   ret = newSVpvs_flags("+;$$@", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_tied || code == -KEY_untie) {
-                   ret = newSVpvs_flags("\\[$@%*]", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_tie) {
-                   ret = newSVpvs_flags("\\[$@%*]$@", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY___FILE__ || code == -KEY___LINE__
-                || code == -KEY___PACKAGE__) {
-                   ret = newSVpvs_flags("", SVs_TEMP);
-                   goto set;
-               }
-               if (code == -KEY_readpipe) {
-                   s = "CORE::backtick";
-               }
-               while (i < MAXO) {      /* The slow way. */
-                   if (strEQ(s + 6, PL_op_name[i])
-                       || strEQ(s + 6, PL_op_desc[i]))
-                   {
-                       goto found;
-                   }
-                   i++;
-               }
-               goto nonesuch;          /* Should not happen... */
-             found:
-               defgv = PL_opargs[i] & OA_DEFGV;
-               oa = PL_opargs[i] >> OASHIFT;
-               while (oa) {
-                   if (oa & OA_OPTIONAL && !seen_question && !defgv) {
-                       seen_question = 1;
-                       str[n++] = ';';
-                   }
-                   if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
-                       && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
-                       /* But globs are already references (kinda) */
-                       && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
-                   ) {
-                       str[n++] = '\\';
-                   }
-                   str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
-                   oa = oa >> 4;
-               }
-               if (defgv && str[n - 1] == '$')
-                   str[n - 1] = '_';
-               str[n++] = '\0';
-               ret = newSVpvn_flags(str, n - 1, SVs_TEMP);
-           }
-           else if (code)              /* Non-Overridable */
-               goto set;
-           else {                      /* None such */
-             nonesuch:
+           if (!code || code == -KEY_CORE)
                DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
+           if (code < 0) {     /* Overridable. */
+               SV * const sv = core_prototype(NULL, s + 6, code, NULL);
+               if (sv) ret = sv;
            }
+           goto set;
        }
     }
     cv = sv_2cv(TOPs, &stash, &gv, 0);