perldelta for #108480: $cow |= number

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index b4a2544..c8e8bfb 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1688,9 +1688,6 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef DEBUGGING
                             " DEBUGGING"
 #  endif
-#  ifdef HOMEGROWN_POSIX_SIGNALS
-                            " HOMEGROWN_POSIX_SIGNALS"
-#  endif
 #  ifdef NO_MATHOMS
                             " NO_MATHOMS"
 #  endif
@@ -1938,15 +1935,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                argc--,argv++;
                goto switch_end;
            }
-           /* catch use of gnu style long options */
-           if (strEQ(s, "version")) {
-               s = (char *)"v";
-               goto reswitch;
-           }
-           if (strEQ(s, "help")) {
-               s = (char *)"h";
-               goto reswitch;
-           }
+           /* catch use of gnu style long options.
+              Both of these exit immediately.  */
+           if (strEQ(s, "version"))
+               minus_v();
+           if (strEQ(s, "help"))
+               usage();
            s--;
            /* FALL THROUGH */
        default:
@@ -2336,7 +2330,7 @@ perl_run(pTHXx)
            POPSTACK_TO(PL_mainstack);
            goto redo_body;
        }
-       PerlIO_printf(Perl_error_log, "panic: restartop\n");
+       PerlIO_printf(Perl_error_log, "panic: restartop in perl_run\n");
        FREETMPS;
        ret = 1;
        break;
@@ -3320,6 +3314,64 @@ Perl_moreswitches(pTHX_ const char *s)
        s++;
        return s;
     case 'v':
+       minus_v();
+    case 'w':
+       if (! (PL_dowarn & G_WARN_ALL_MASK)) {
+           PL_dowarn |= G_WARN_ON;
+       }
+       s++;
+       return s;
+    case 'W':
+       PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            PerlMemShared_free(PL_compiling.cop_warnings);
+       PL_compiling.cop_warnings = pWARN_ALL ;
+       s++;
+       return s;
+    case 'X':
+       PL_dowarn = G_WARN_ALL_OFF;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            PerlMemShared_free(PL_compiling.cop_warnings);
+       PL_compiling.cop_warnings = pWARN_NONE ;
+       s++;
+       return s;
+    case '*':
+    case ' ':
+        while( *s == ' ' )
+          ++s;
+       if (s[0] == '-')        /* Additional switches on #! line. */
+           return s+1;
+       break;
+    case '-':
+    case 0:
+#if defined(WIN32) || !defined(PERL_STRICT_CR)
+    case '\r':
+#endif
+    case '\n':
+    case '\t':
+       break;
+#ifdef ALTERNATE_SHEBANG
+    case 'S':                  /* OS/2 needs -S on "extproc" line. */
+       break;
+#endif
+    case 'e': case 'f': case 'x': case 'E':
+#ifndef ALTERNATE_SHEBANG
+    case 'S':
+#endif
+    case 'V':
+       Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
+    default:
+       Perl_croak(aTHX_
+           "Unrecognized switch: -%.1s  (-h will show valid options)",s
+       );
+    }
+    return NULL;
+}
+
+
+STATIC void
+S_minus_v(pTHX)
+{
        if (!sv_derived_from(PL_patchlevel, "version"))
            upg_version(PL_patchlevel, TRUE);
 #if !defined(DGUX)
@@ -3437,49 +3489,6 @@ Complete documentation for Perl, including FAQ lists, should be found on\n\
 this system using \"man perl\" or \"perldoc perl\".  If you have access to the\n\
 Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
        my_exit(0);
-    case 'w':
-       if (! (PL_dowarn & G_WARN_ALL_MASK)) {
-           PL_dowarn |= G_WARN_ON;
-       }
-       s++;
-       return s;
-    case 'W':
-       PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
-        if (!specialWARN(PL_compiling.cop_warnings))
-            PerlMemShared_free(PL_compiling.cop_warnings);
-       PL_compiling.cop_warnings = pWARN_ALL ;
-       s++;
-       return s;
-    case 'X':
-       PL_dowarn = G_WARN_ALL_OFF;
-        if (!specialWARN(PL_compiling.cop_warnings))
-            PerlMemShared_free(PL_compiling.cop_warnings);
-       PL_compiling.cop_warnings = pWARN_NONE ;
-       s++;
-       return s;
-    case '*':
-    case ' ':
-        while( *s == ' ' )
-          ++s;
-       if (s[0] == '-')        /* Additional switches on #! line. */
-           return s+1;
-       break;
-    case '-':
-    case 0:
-#if defined(WIN32) || !defined(PERL_STRICT_CR)
-    case '\r':
-#endif
-    case '\n':
-    case '\t':
-       break;
-#ifdef ALTERNATE_SHEBANG
-    case 'S':                  /* OS/2 needs -S on "extproc" line. */
-       break;
-#endif
-    default:
-       Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
-    }
-    return NULL;
 }
 
 /* compliments of Tom Christiansen */
@@ -3888,6 +3897,8 @@ Perl_init_dbargs(pTHX)
           It might have entries, and if we just turn off AvREAL(), they will
           "leak" until global destruction.  */
        av_clear(args);
+       if (SvTIED_mg((const SV *)args, PERL_MAGIC_tied))
+           Perl_croak(aTHX_ "Cannot set tied @DB::args");
     }
     AvREIFY_only(PL_dbargs);
 }
@@ -4077,7 +4088,7 @@ S_init_predump_symbols(pTHX)
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
 
-    PL_statname = newSV(0);            /* last filename we did stat on */
+    PL_statname = newSVpvs("");                /* last filename we did stat on */
 }
 
 void
@@ -4809,7 +4820,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                CopLINE_set(PL_curcop, oldline);
                JMPENV_JUMP(3);
            }
-           PerlIO_printf(Perl_error_log, "panic: restartop\n");
+           PerlIO_printf(Perl_error_log, "panic: restartop in call_list\n");
            FREETMPS;
            break;
        }