Test script for DynaLoader

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index a866fcb..f5e24fc 100644 (file)
--- a/op.c
+++ b/op.c
@@ -230,7 +230,7 @@ S_no_bareword_allowed(pTHX_ const OP *o)
 /* "register" allocation */
 
 PADOFFSET
-Perl_allocmy(pTHX_ char *name)
+Perl_allocmy(pTHX_ const char *const name)
 {
     dVAR;
     PADOFFSET off;
@@ -245,29 +245,11 @@ Perl_allocmy(pTHX_ char *name)
     {
        /* name[2] is true if strlen(name) > 2  */
        if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
-           /* 1999-02-27 mjd@plover.com */
-           char *p;
-           p = strchr(name, '\0');
-           /* The next block assumes the buffer is at least 205 chars
-              long.  At present, it's always at least 256 chars. */
-           if (p - name > 200) {
-#ifdef HAS_STRLCPY
-               strlcpy(name + 200, "...", 4);
-#else
-               strcpy(name + 200, "...");
-#endif
-               p = name + 199;
-           }
-           else {
-               p[1] = '\0';
-           }
-           /* Move everything else down one character */
-           for (; p-name > 2; p--)
-               *p = *(p-1);
-           name[2] = toCTRL(name[1]);
-           name[1] = '^';
+           yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"my\"",
+                             name[0], toCTRL(name[1]), name + 2));
+       } else {
+           yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
        }
-       yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
 
     /* check for duplicate declaration */
@@ -2153,6 +2135,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     int ret = 0;
     I32 oldscope;
     OP *old_next;
+    SV * const oldwarnhook = PL_warnhook;
+    SV * const olddiehook  = PL_diehook;
     dJMPENV;
 
     if (PL_opargs[type] & OA_RETSCALAR)
@@ -2214,6 +2198,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     oldscope = PL_scopestack_ix;
     create_eval_scope(G_FAKINGEVAL);
 
+    PL_warnhook = PERL_WARNHOOK_FATAL;
+    PL_diehook  = NULL;
     JMPENV_PUSH(ret);
 
     switch (ret) {
@@ -2227,11 +2213,6 @@ Perl_fold_constants(pTHX_ register OP *o)
            SvTEMP_off(sv);
        }
        break;
-    case 2:
-       /* my_exit() was called; propagate it */
-       JMPENV_POP;
-       JMPENV_JUMP(2);
-       /* NOTREACHED */
     case 3:
        /* Something tried to die.  Abandon constant folding.  */
        /* Pretend the error never happened.  */
@@ -2240,11 +2221,16 @@ Perl_fold_constants(pTHX_ register OP *o)
        break;
     default:
        JMPENV_POP;
-       /* Don't expect 1 (setjmp failed) */
+       /* Don't expect 1 (setjmp failed) or 2 (something called my_exit)  */
+       PL_warnhook = oldwarnhook;
+       PL_diehook  = olddiehook;
+       /* XXX note that this croak may fail as we've already blown away
+        * the stack - eg any nested evals */
        Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
     }
-
     JMPENV_POP;
+    PL_warnhook = oldwarnhook;
+    PL_diehook  = olddiehook;
 
     if (PL_scopestack_ix > oldscope)
        delete_eval_scope();