In S_mro_get_linear_isa_dfs(), add void casts to silence two warnings

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index a7f6ab5..98437a3 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1127,18 +1127,11 @@ perl_destruct(pTHXx)
     }
 
     /* Now absolutely destruct everything, somehow or other, loops or no. */
-    SvFLAGS(PL_fdpid) |= SVTYPEMASK;           /* don't clean out pid table now */
-    SvFLAGS(PL_strtab) |= SVTYPEMASK;          /* don't clean out strtab now */
 
     /* the 2 is for PL_fdpid and PL_strtab */
-    while (PL_sv_count > 2 && sv_clean_all())
+    while (sv_clean_all() > 2)
        ;
 
-    SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
-    SvFLAGS(PL_fdpid) |= SVt_PVAV;
-    SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
-    SvFLAGS(PL_strtab) |= SVt_PVHV;
-
     AvREAL_off(PL_fdpid);              /* no surviving entries */
     SvREFCNT_dec(PL_fdpid);            /* needed in io_close() */
     PL_fdpid = NULL;
@@ -1984,7 +1977,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
        (s = PerlEnv_getenv("PERL5OPT")))
     {
-       const char *popt = s;
        while (isSPACE(*s))
            s++;
        if (*s == '-' && *(s+1) == 'T') {
@@ -1995,7 +1987,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        else {
            char *popt_copy = NULL;
            while (s && *s) {
-               char *d;
+               const char *d;
                while (isSPACE(*s))
                    s++;
                if (*s == '-') {
@@ -2011,9 +2003,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                while (++s && *s) {
                    if (isSPACE(*s)) {
                        if (!popt_copy) {
-                           popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0)));
-                           s = popt_copy + (s - popt);
-                           d = popt_copy + (d - popt);
+                           popt_copy = SvPVX(sv_2mortal(newSVpv(d,0)));
+                           s = popt_copy + (s - d);
+                           d = popt_copy;
                        }
                        *s++ = '\0';
                        break;
@@ -2687,8 +2679,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
  redo_body:
            CALL_BODY_SUB((OP*)&myop);
            retval = PL_stack_sp - (PL_stack_base + oldmark);
-           if (!(flags & G_KEEPERR))
-               sv_setpvn(ERRSV,"",0);
+           if (!(flags & G_KEEPERR)) {
+               CLEAR_ERRSV();
+           }
            break;
        case 1:
            STATUS_ALL_FAILURE;
@@ -2788,8 +2781,9 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
  redo_body:
        CALL_BODY_EVAL((OP*)&myop);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
-       if (!(flags & G_KEEPERR))
-           sv_setpvn(ERRSV,"",0);
+       if (!(flags & G_KEEPERR)) {
+           CLEAR_ERRSV();
+       }
        break;
     case 1:
        STATUS_ALL_FAILURE;
@@ -3025,6 +3019,7 @@ Perl_moreswitches(pTHX_ const char *s)
 {
     dVAR;
     UV rschar;
+    const char option = *s; /* used to remember option in -m/-M code */
 
     PERL_ARGS_ASSERT_MORESWITCHES;
 
@@ -3224,6 +3219,7 @@ Perl_moreswitches(pTHX_ const char *s)
            const char *end;
            SV *sv;
            const char *use = "use ";
+           bool colon = FALSE;
            /* -M-foo == 'no foo'       */
            /* Leading space on " no " is deliberate, to make both
               possibilities the same length.  */
@@ -3231,19 +3227,30 @@ Perl_moreswitches(pTHX_ const char *s)
            sv = newSVpvn(use,4);
            start = s;
            /* We allow -M'Module qw(Foo Bar)'  */
-           while(isALNUM(*s) || *s==':') ++s;
+           while(isALNUM(*s) || *s==':') {
+               if( *s++ == ':' ) {
+                   if( *s == ':' ) 
+                       s++;
+                   else
+                       colon = TRUE;
+               }
+           }
+           if (s == start)
+               Perl_croak(aTHX_ "Module name required with -%c option",
+                                   option);
+           if (colon) 
+               Perl_croak(aTHX_ "Invalid module name %.*s with -%c option: "
+                                   "contains single ':'",
+                                   (int)(s - start), start, option);
            end = s + strlen(s);
            if (*s != '=') {
                sv_catpvn(sv, start, end - start);
-               if (*(start-1) == 'm') {
+               if (option == 'm') {
                    if (*s != '\0')
                        Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
                    sv_catpvs( sv, " ()");
                }
            } else {
-                if (s == start)
-                    Perl_croak(aTHX_ "Module name required with -%c option",
-                              s[-1]);
                sv_catpvn(sv, start, s-start);
                /* Use NUL as q''-delimiter.  */
                sv_catpvs(sv, " split(/,/,q\0");
@@ -3255,7 +3262,7 @@ Perl_moreswitches(pTHX_ const char *s)
            Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
        }
        else
-           Perl_croak(aTHX_ "Missing argument to -%c", *(s-1));
+           Perl_croak(aTHX_ "Missing argument to -%c", option);
        return s;
     case 'n':
        PL_minus_n = TRUE;
@@ -3424,8 +3431,10 @@ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
        return s;
     case '*':
     case ' ':
-       if (s[1] == '-')        /* Additional switches on #! line. */
-           return s+2;
+        while( *s == ' ' )
+          ++s;
+       if (s[0] == '-')        /* Additional switches on #! line. */
+           return s+1;
        break;
     case '-':
     case 0:
@@ -3554,7 +3563,7 @@ S_init_main_stash(pTHX)
     gv_SVadd(PL_errgv);
 #endif
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
-    sv_setpvn(ERRSV, "", 0);
+    CLEAR_ERRSV();
     PL_curstash = PL_defstash;
     CopSTASH_set(&PL_compiling, PL_defstash);
     PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
@@ -4239,6 +4248,8 @@ S_validate_suid(pTHX_ PerlIO *rsfp)
 
     if (PL_euid != PL_uid || PL_egid != PL_gid) {      /* (suidperl doesn't exist, in fact) */
 #  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+       dVAR;
+
        PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
        if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
            ||
@@ -4662,18 +4673,21 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            environ[0] = NULL;
        }
        if (env) {
-         char *s;
+         char *s, *old_var;
          SV *sv;
          for (; *env; env++) {
-           if (!(s = strchr(*env,'=')) || s == *env)
+           old_var = *env;
+
+           if (!(s = strchr(old_var,'=')) || s == old_var)
                continue;
+
 #if defined(MSDOS) && !defined(DJGPP)
            *s = '\0';
-           (void)strupr(*env);
+           (void)strupr(old_var);
            *s = '=';
 #endif
            sv = newSVpv(s+1, 0);
-           (void)hv_store(hv, *env, s - *env, sv, 0);
+           (void)hv_store(hv, old_var, s - old_var, sv, 0);
            if (env_is_not_environ)
                mg_set(sv);
          }