This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make regexp_paren_pair.start_tmp an offset
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 2385f89..f7f6c2b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -24,7 +24,7 @@
  * function of the interpreter; that can be found in perlmain.c
  */
 
-#ifdef PERL_IS_MINIPERL
+#if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE)
 #  define USE_SITECUSTOMIZE
 #endif
 
@@ -77,11 +77,9 @@ char *getenv (char *); /* Usually in <stdlib.h> */
 static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-/* Drop everything. Heck, don't even try to call it */
-#  define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
+#  define validate_suid(rsfp) NOOP
 #else
-/* Drop almost everything */
-#  define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
+#  define validate_suid(rsfp) S_validate_suid(aTHX_ rsfp)
 #endif
 
 #define CALL_BODY_SUB(myop) \
@@ -309,6 +307,7 @@ perl_construct(pTHXx)
        else all hell breaks loose in S_find_uninit_var().  */
     Perl_av_create_and_push(aTHX_ &PL_regex_padav, newSVpvs(""));
     PL_regex_pad = AvARRAY(PL_regex_padav);
+    Newxz(PL_stashpad, PL_stashpadmax, HV *);
 #endif
 #ifdef USE_REENTRANT_API
     Perl_reentrant_init(aTHX);
@@ -830,7 +829,6 @@ perl_destruct(pTHXx)
 #endif
 
        CopFILE_free(&PL_compiling);
-       CopSTASH_free(&PL_compiling);
 
        /* The exit() function will do everything that needs doing. */
         return STATUS_EXIT;
@@ -842,11 +840,19 @@ perl_destruct(pTHXx)
      * REGEXPs in the parent interpreter
      * we need to manually ReREFCNT_dec for the clones
      */
-    SvREFCNT_dec(PL_regex_padav);
-    PL_regex_padav = NULL;
-    PL_regex_pad = NULL;
+    {
+       I32 i = AvFILLp(PL_regex_padav);
+       SV **ary = AvARRAY(PL_regex_padav);
+
+       for (; i; i--) {
+           SvREFCNT_dec(ary[i]);
+           ary[i] = &PL_sv_undef;
+       }
+    }
+    Safefree(PL_stashpad);
 #endif
 
+
     SvREFCNT_dec(MUTABLE_SV(PL_stashcache));
     PL_stashcache = NULL;
 
@@ -1026,7 +1032,6 @@ perl_destruct(pTHXx)
     cophh_free(CopHINTHASH_get(&PL_compiling));
     CopHINTHASH_set(&PL_compiling, cophh_new_empty());
     CopFILE_free(&PL_compiling);
-    CopSTASH_free(&PL_compiling);
 
     /* Prepare to destruct main symbol table.  */
 
@@ -1062,6 +1067,12 @@ perl_destruct(pTHXx)
                             (long)cxstack_ix + 1);
     }
 
+#ifdef USE_ITHREADS
+    SvREFCNT_dec(PL_regex_padav);
+    PL_regex_padav = NULL;
+    PL_regex_pad = NULL;
+#endif
+
 #ifdef PERL_IMPLICIT_CONTEXT
     /* the entries in this list are allocated via SV PVX's, so get freed
      * in sv_clean_all */
@@ -1225,9 +1236,6 @@ perl_destruct(pTHXx)
 
     Safefree(PL_origfilename);
     PL_origfilename = NULL;
-    Safefree(PL_reg_start_tmp);
-    PL_reg_start_tmp = (char**)NULL;
-    PL_reg_start_tmpl = 0;
     Safefree(PL_reg_curpm);
     Safefree(PL_reg_poscache);
     free_tied_hv_pool();
@@ -1801,14 +1809,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
 #endif
-    SV *linestr_sv = newSV_type(SVt_PVIV);
+    SV *linestr_sv = NULL;
     bool add_read_e_script = FALSE;
+    U32 lex_start_flags = 0;
 
     PERL_SET_PHASE(PERL_PHASE_START);
 
-    SvGROW(linestr_sv, 80);
-    sv_setpvs(linestr_sv,"");
-
     init_main_stash();
 
     {
@@ -2038,17 +2044,19 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  else
        /* SITELIB_EXP is a function call on Win32.  */
        const char *const raw_sitelib = SITELIB_EXP;
-       /* process .../.. if PERL_RELOCATABLE_INC is defined */
-       SV *sitelib_sv = mayberelocate(raw_sitelib, strlen(raw_sitelib),
-                                      INCPUSH_CAN_RELOCATE);
-       const char *const sitelib = SvPVX(sitelib_sv);
-       (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
-                                            Perl_newSVpvf(aTHX_
-                                                          "BEGIN { do {local $!; -f q%c%s/sitecustomize.pl%c} && do q%c%s/sitecustomize.pl%c }",
-                                                          0, sitelib, 0,
-                                                          0, sitelib, 0));
-       assert (SvREFCNT(sitelib_sv) == 1);
-       SvREFCNT_dec(sitelib_sv);
+       if (raw_sitelib) {
+           /* process .../.. if PERL_RELOCATABLE_INC is defined */
+           SV *sitelib_sv = mayberelocate(raw_sitelib, strlen(raw_sitelib),
+                                          INCPUSH_CAN_RELOCATE);
+           const char *const sitelib = SvPVX(sitelib_sv);
+           (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
+                                                Perl_newSVpvf(aTHX_
+                                                              "BEGIN { do {local $!; -f q%c%s/sitecustomize.pl%c} && do q%c%s/sitecustomize.pl%c }",
+                                                              0, sitelib, 0,
+                                                              0, sitelib, 0));
+           assert (SvREFCNT(sitelib_sv) == 1);
+           SvREFCNT_dec(sitelib_sv);
+       }
 #  endif
     }
 #endif
@@ -2074,9 +2082,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        bool suidscript = FALSE;
 
        rsfp = open_script(scriptname, dosearch, &suidscript);
+       if (!rsfp) {
+           rsfp = PerlIO_stdin();
+           lex_start_flags = LEX_DONT_CLOSE_RSFP;
+       }
 
-       validate_suid(validarg, scriptname, fdscript, suidscript,
-                     linestr_sv, rsfp);
+       validate_suid(rsfp);
 
 #ifndef PERL_MICRO
 #  if defined(SIGCHLD) || defined(SIGCLD)
@@ -2101,6 +2112,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            forbid_setid('x', suidscript);
            /* Hence you can't get here if suidscript is true */
 
+           linestr_sv = newSV_type(SVt_PV);
+           lex_start_flags |= LEX_START_COPIED;
            find_beginning(linestr_sv, rsfp);
            if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
                Perl_croak(aTHX_ "Can't chdir to %s",cddir);
@@ -2228,7 +2241,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
 #endif
 
-    lex_start(linestr_sv, rsfp, 0);
+    lex_start(linestr_sv, rsfp, lex_start_flags);
+    if(linestr_sv)
+       SvREFCNT_dec(linestr_sv);
+
     PL_subname = newSVpvs("main");
 
     if (add_read_e_script)
@@ -2789,6 +2805,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     myop.op_flags |= OP_GIMME_REVERSE(flags);
     if (flags & G_KEEPERR)
        myop.op_flags |= OPf_SPECIAL;
+    if (PL_reg_state.re_reparsing)
+       myop.op_private = OPpEVAL_COPHH;
 
     /* fail now; otherwise we could fail after the JMPENV_PUSH but
      * before a PUSHEVAL, which corrupts the stack after a croak */
@@ -3500,6 +3518,10 @@ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
 /* unexec() can be found in the Gnu emacs distribution */
 /* Known to work with -DUNEXEC and using unexelf.c from GNU emacs-20.2 */
 
+#ifdef VMS
+#include <lib$routines.h>
+#endif
+
 void
 Perl_my_unexec(pTHX)
 {
@@ -3518,7 +3540,6 @@ Perl_my_unexec(pTHX)
     PerlProc_exit(status);
 #else
 #  ifdef VMS
-#    include <lib$routines.h>
      lib$signal(SS$_DEBUG);  /* ssdef.h #included from vmsish.h */
 #  elif defined(WIN32) || defined(__CYGWIN__)
     Perl_croak(aTHX_ "dump is not supported");
@@ -3669,15 +3690,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
        scriptname = (char *)"";
     if (fdscript >= 0) {
        rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
-#       if defined(HAS_FCNTL) && defined(F_SETFD)
-           if (rsfp)
-                /* ensure close-on-exec */
-               fcntl(PerlIO_fileno(rsfp),F_SETFD,1);
-#       endif
     }
     else if (!*scriptname) {
        forbid_setid(0, *suidscript);
-       rsfp = PerlIO_stdin();
+       return NULL;
     }
     else {
 #ifdef FAKE_BIT_BUCKET
@@ -3721,11 +3737,6 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
        }
        scriptname = BIT_BUCKET;
 #endif
-#       if defined(HAS_FCNTL) && defined(F_SETFD)
-           if (rsfp)
-                /* ensure close-on-exec */
-               fcntl(PerlIO_fileno(rsfp),F_SETFD,1);
-#       endif
     }
     if (!rsfp) {
        /* PSz 16 Sep 03  Keep neat error message */
@@ -3735,6 +3746,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
            Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                    CopFILE(PL_curcop), Strerror(errno));
     }
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    /* ensure close-on-exec */
+    fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
+#endif
     return rsfp;
 }
 
@@ -4977,8 +4992,8 @@ read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */