This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Fix the error message "Can't call method "DOES" on unblessed
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 9c7b314..67a7907 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -171,7 +171,12 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
        MUTEX_INIT(&PL_my_ctx_mutex);
 #  endif
     }
-    else {
+#if defined(USE_ITHREADS)
+    else
+#else
+    /* This always happens for non-ithreads  */
+#endif
+    {
        PERL_SET_THX(my_perl);
     }
 }
@@ -257,8 +262,8 @@ perl_construct(pTHXx)
     if (!PL_linestr) {
        PL_curcop = &PL_compiling;      /* needed by ckWARN, right away */
 
-       PL_linestr = newSV(79);
-       sv_upgrade(PL_linestr,SVt_PVIV);
+       PL_linestr = newSV_type(SVt_PVIV);
+       SvGROW(PL_linestr, 80);
 
        if (!SvREADONLY(&PL_sv_undef)) {
            /* set read-only and try to insure than we wont see REFCNT==0
@@ -321,8 +326,8 @@ perl_construct(pTHXx)
     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);       /* ext/re needs these */
     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);       /* even without DEBUGGING. */
 #ifdef USE_ITHREADS
-    PL_regex_padav = newAV();
-    av_push(PL_regex_padav,(SV*)newAV());    /* First entry is an array of empty elements */
+    /* First entry is an array of empty elements */
+    Perl_av_create_and_push(aTHX_ &PL_regex_padav,(SV*)newAV());
     PL_regex_pad = AvARRAY(PL_regex_padav);
 #endif
 #ifdef USE_REENTRANT_API
@@ -1551,8 +1556,10 @@ setuid perl scripts securely.\n");
                        break;
              }
         }
+
+#ifndef PERL_USE_SAFE_PUTENV
         /* Can we grab env area too to be used as the area for $0? */
-        if (s && PL_origenviron) {
+        if (s && PL_origenviron && !PL_use_safe_putenv) {
              if ((PL_origenviron[0] == s + 1)
                  ||
                  (aligned &&
@@ -1584,6 +1591,8 @@ setuid perl scripts securely.\n");
                   }
              }
         }
+#endif /* !defined(PERL_USE_SAFE_PUTENV) */
+
         PL_origalen = s ? s - PL_origargv[0] + 1 : 0;
     }
 
@@ -1796,10 +1805,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            {
                SV *opts_prog;
 
-               if (!PL_preambleav)
-                   PL_preambleav = newAV();
-               av_push(PL_preambleav,
-                       newSVpvs("use Config;"));
+               Perl_av_create_and_push(aTHX_ &PL_preambleav, newSVpvs("use Config;"));
                if (*++s != ':')  {
                    STRLEN opts;
                
@@ -1851,6 +1857,21 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PERL_MALLOC_WRAP
                             " PERL_MALLOC_WRAP"
 #  endif
+#  ifdef PERL_MEM_LOG
+                            " PERL_MEM_LOG"
+#  endif
+#  ifdef PERL_MEM_LOG_ENV
+                            " PERL_MEM_LOG_ENV"
+#  endif
+#  ifdef PERL_MEM_LOG_ENV_FD
+                            " PERL_MEM_LOG_ENV_FD"
+#  endif
+#  ifdef PERL_MEM_LOG_STDERR
+                            " PERL_MEM_LOG_STDERR"
+#  endif
+#  ifdef PERL_MEM_LOG_TIMESTAMP
+                            " PERL_MEM_LOG_TIMESTAMP"
+#  endif
 #  ifdef PERL_NEED_APPCTX
                             " PERL_NEED_APPCTX"
 #  endif
@@ -1860,15 +1881,18 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PERL_OLD_COPY_ON_WRITE
                             " PERL_OLD_COPY_ON_WRITE"
 #  endif
+#  ifdef PERL_POISON
+                            " PERL_POISON"
+#  endif
 #  ifdef PERL_TRACK_MEMPOOL
                             " PERL_TRACK_MEMPOOL"
 #  endif
 #  ifdef PERL_USE_SAFE_PUTENV
                             " PERL_USE_SAFE_PUTENV"
 #  endif
-#ifdef PERL_USES_PL_PIDSTATUS
+#  ifdef PERL_USES_PL_PIDSTATUS
                             " PERL_USES_PL_PIDSTATUS"
-#endif
+#  endif
 #  ifdef PL_OP_SLAB_ALLOC
                             " PL_OP_SLAB_ALLOC"
 #  endif
@@ -2060,10 +2084,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
 #ifdef USE_SITECUSTOMIZE
     if (!minus_f) {
-       if (!PL_preambleav)
-           PL_preambleav = newAV();
-       av_unshift(PL_preambleav, 1);
-       (void)av_store(PL_preambleav, 0, Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP));
+       (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
+                                            Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP));
     }
 #endif
 
@@ -2129,8 +2151,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        }
     }
 
-    PL_main_cv = PL_compcv = (CV*)newSV(0);
-    sv_upgrade((SV *)PL_compcv, SVt_PVCV);
+    PL_main_cv = PL_compcv = (CV*)newSV_type(SVt_PVCV);
     CvUNIQUE_on(PL_compcv);
 
     CvPADLIST(PL_compcv) = pad_new(0);
@@ -2497,7 +2518,6 @@ CV*
 Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
 {
     GV* const gv = gv_fetchpvn_flags(name, len, flags, SVt_PVCV);
-    /* XXX unsafe for threads if eval_owner isn't held */
     /* XXX this is probably not what they think they're getting.
      * It has the same effect as "sub name;", i.e. just a forward
      * declaration! */
@@ -3182,8 +3202,6 @@ Perl_moreswitches(pTHX_ char *s)
        return s;
     case 'A':
        forbid_setid('A', -1);
-       if (!PL_preambleav)
-           PL_preambleav = newAV();
        s++;
        {
            char * const start = s;
@@ -3200,7 +3218,7 @@ Perl_moreswitches(pTHX_ char *s)
            else if (*s != '\0') {
                Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, (int)(s-start), start);
            }
-           av_push(PL_preambleav, sv);
+           Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
            return s;
        }
     case 'M':
@@ -3238,9 +3256,7 @@ Perl_moreswitches(pTHX_ char *s)
                sv_catpvs(sv,  "\0)");
            }
            s += strlen(s);
-           if (!PL_preambleav)
-               PL_preambleav = newAV();
-           av_push(PL_preambleav, sv);
+           Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
        }
        else
            Perl_croak(aTHX_ "Missing argument to -%c", *(s-1));
@@ -3281,7 +3297,7 @@ Perl_moreswitches(pTHX_ char *s)
        return s;
     case 'v':
        if (!sv_derived_from(PL_patchlevel, "version"))
-           upg_version(PL_patchlevel);
+           upg_version(PL_patchlevel, TRUE);
 #if !defined(DGUX)
        PerlIO_printf(PerlIO_stdout(),
                Perl_form(aTHX_ "\nThis is perl, %"SVf
@@ -4646,11 +4662,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     dVAR;
     GV* tmpgv;
 
-    PL_toptarget = newSV(0);
-    sv_upgrade(PL_toptarget, SVt_PVFM);
+    PL_toptarget = newSV_type(SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
-    PL_bodytarget = newSV(0);
-    sv_upgrade(PL_bodytarget, SVt_PVFM);
+    PL_bodytarget = newSV_type(SVt_PVFM);
     sv_setpvn(PL_bodytarget, "", 0);
     PL_formtarget = PL_bodytarget;
 
@@ -4692,7 +4706,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            environ[0] = NULL;
        }
        if (env) {
-          char** origenv = environ;
          char *s;
          SV *sv;
          for (; *env; env++) {
@@ -4707,11 +4720,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            (void)hv_store(hv, *env, s - *env, sv, 0);
            if (env_is_not_environ)
                mg_set(sv);
-           if (origenv != environ) {
-             /* realloc has shifted us */
-             env = (env - origenv) + environ;
-             origenv = environ;
-           }
          }
       }
 #endif /* USE_ENVIRON_ARRAY */
@@ -4731,9 +4739,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     if (PL_minus_a) {
       (void) get_av("main::F", TRUE | GV_ADDMULTI);
     }
-    /* touch @- and @+ arrays to prevent spurious warnings 20020415 MJD */
-    (void) get_av("main::-", TRUE | GV_ADDMULTI);
-    (void) get_av("main::+", TRUE | GV_ADDMULTI);
 }
 
 STATIC void
@@ -5123,7 +5128,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 {
     dVAR;
     SV *atsv;
-    const line_t oldline = CopLINE(PL_curcop);
+    volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
     CV *cv;
     STRLEN len;
     int ret;
@@ -5134,21 +5139,15 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
        if (PL_savebegin) {
            if (paramList == PL_beginav) {
                /* save PL_beginav for compiler */
-               if (! PL_beginav_save)
-                   PL_beginav_save = newAV();
-               av_push(PL_beginav_save, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_beginav_save, (SV*)cv);
            }
            else if (paramList == PL_checkav) {
                /* save PL_checkav for compiler */
-               if (! PL_checkav_save)
-                   PL_checkav_save = newAV();
-               av_push(PL_checkav_save, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_checkav_save, (SV*)cv);
            }
            else if (paramList == PL_unitcheckav) {
                /* save PL_unitcheckav for compiler */
-               if (! PL_unitcheckav_save)
-                   PL_unitcheckav_save = newAV();
-               av_push(PL_unitcheckav_save, (SV*)cv);
+               Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, (SV*)cv);
            }
        } else {
            if (!PL_madskills)
Unnamed repository; edit this file 'description' to name the repository.