X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/985213f2fede57896814a0d7f5d12b04cc05be5b..c0fcb8c5be7ac45a02537b1427a228c526293b5b:/perl.c diff --git a/perl.c b/perl.c index b238d04..87d98dc 100644 --- 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 @@ -58,10 +58,6 @@ union control_un { #endif -#ifdef __BEOS__ -# define HZ 1000000 -#endif - #ifndef HZ # ifdef CLK_TCK # define HZ CLK_TCK @@ -77,11 +73,9 @@ char *getenv (char *); /* Usually in */ 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) \ @@ -244,32 +238,10 @@ perl_construct(pTHXx) #endif PL_curcop = &PL_compiling; /* needed by ckWARN, right away */ - /* set read-only and try to insure than we wont see REFCNT==0 - very often */ - - SvREADONLY_on(&PL_sv_undef); - SvREFCNT(&PL_sv_undef) = (~(U32)0)/2; - - sv_setpv(&PL_sv_no,PL_No); - /* value lookup in void context - happens to have the side effect - of caching the numeric forms. However, as &PL_sv_no doesn't contain - a string that is a valid numer, we have to turn the public flags by - hand: */ - SvNV(&PL_sv_no); - SvIV(&PL_sv_no); - SvIOK_on(&PL_sv_no); - SvNOK_on(&PL_sv_no); - SvREADONLY_on(&PL_sv_no); - SvREFCNT(&PL_sv_no) = (~(U32)0)/2; - - sv_setpv(&PL_sv_yes,PL_Yes); - SvNV(&PL_sv_yes); - SvIV(&PL_sv_yes); - SvREADONLY_on(&PL_sv_yes); - SvREFCNT(&PL_sv_yes) = (~(U32)0)/2; + init_constants(); SvREADONLY_on(&PL_sv_placeholder); - SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2; + SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL; PL_sighandlerp = (Sighandler_t) Perl_sighandler; #ifdef PERL_USES_PL_PIDSTATUS @@ -309,10 +281,24 @@ 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); #endif +#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) + /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0 + * This MUST be done before any hash stores or fetches take place. + * If you set PL_hash_seed (and presumably also PL_hash_seed_set) + * yourself, it is your responsibility to provide a good random seed! + * You can also define PERL_HASH_SEED in compile time, see hv.h. + * + * XXX: fix this comment */ + if (PL_hash_seed_set == FALSE) { + Perl_get_hash_seed(aTHX_ PL_hash_seed); + PL_hash_seed_set= TRUE; + } +#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */ /* Note that strtab is a rather special HV. Assumptions are made about not iterating on it, and not adding tie magic to it. @@ -335,10 +321,9 @@ perl_construct(pTHXx) /* Use sysconf(_SC_CLK_TCK) if available, if not * available or if the sysconf() fails, use the HZ. - * BeOS has those, but returns the wrong value. * The HZ if not originally defined has been by now * been defined as CLK_TCK, if available. */ -#if defined(HAS_SYSCONF) && defined(_SC_CLK_TCK) && !defined(__BEOS__) +#if defined(HAS_SYSCONF) && defined(_SC_CLK_TCK) PL_clocktick = sysconf(_SC_CLK_TCK); if (PL_clocktick <= 0) #endif @@ -533,6 +518,7 @@ perl_destruct(pTHXx) #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP pid_t child; #endif + int i; PERL_ARGS_ASSERT_PERL_DESTRUCT; #ifndef MULTIPLICITY @@ -545,13 +531,18 @@ perl_destruct(pTHXx) PERL_WAIT_FOR_CHILDREN; destruct_level = PL_perl_destruct_level; -#ifdef DEBUGGING +#if defined(DEBUGGING) || defined(PERL_TRACK_MEMPOOL) { const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"); if (s) { - const int i = atoi(s); - if (destruct_level < i) - destruct_level = i; + const int i = atoi(s); +#ifdef DEBUGGING + if (destruct_level < i) destruct_level = i; +#endif +#ifdef PERL_TRACK_MEMPOOL + /* RT #114496, for perl_free */ + PL_perl_destruct_level = i; +#endif } } #endif @@ -738,10 +729,10 @@ perl_destruct(pTHXx) /* We must account for everything. */ /* Destroy the main CV and syntax tree */ - /* Do this now, because destroying ops can cause new SVs to be generated - in Perl_pad_swipe, and when running with -DDEBUG_LEAKING_SCALARS they - PL_curcop to point to a valid op from which the filename structure - member is copied. */ + /* Set PL_curcop now, because destroying ops can cause new SVs + to be generated in Perl_pad_swipe, and when running with + -DDEBUG_LEAKING_SCALARS they expect PL_curcop to point to a valid + op from which the filename structure member is copied. */ PL_curcop = &PL_compiling; if (PL_main_root) { /* ensure comppad/curpad to refer to main's pad */ @@ -767,15 +758,12 @@ perl_destruct(pTHXx) PerlIO_destruct(aTHX); - if (PL_sv_objcount) { - /* - * Try to destruct global references. We do this first so that the - * destructors and destructees still exist. Some sv's might remain. - * Non-referenced objects are on their own. - */ - sv_clean_objs(); - PL_sv_objcount = 0; - } + /* + * Try to destruct global references. We do this first so that the + * destructors and destructees still exist. Some sv's might remain. + * Non-referenced objects are on their own. + */ + sv_clean_objs(); /* unhook hooks which will soon be, or use, destroyed data */ SvREFCNT_dec(PL_warnhook); @@ -830,7 +818,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 +829,18 @@ 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; + } + } #endif + SvREFCNT_dec(MUTABLE_SV(PL_stashcache)); PL_stashcache = NULL; @@ -871,7 +865,9 @@ perl_destruct(pTHXx) PL_minus_F = FALSE; PL_doswitches = FALSE; PL_dowarn = G_WARN_OFF; - PL_sawampersand = FALSE; /* must save all match strings */ +#ifdef PERL_SAWAMPERSAND + PL_sawampersand = 0; /* must save all match strings */ +#endif PL_unsafe = FALSE; Safefree(PL_inplace); @@ -982,17 +978,11 @@ perl_destruct(pTHXx) PL_numeric_radix_sv = NULL; #endif - /* clear utf8 character classes */ - SvREFCNT_dec(PL_utf8_alnum); - SvREFCNT_dec(PL_utf8_alpha); - SvREFCNT_dec(PL_utf8_space); - SvREFCNT_dec(PL_utf8_graph); - SvREFCNT_dec(PL_utf8_digit); - SvREFCNT_dec(PL_utf8_upper); - SvREFCNT_dec(PL_utf8_lower); - SvREFCNT_dec(PL_utf8_print); - SvREFCNT_dec(PL_utf8_punct); - SvREFCNT_dec(PL_utf8_xdigit); + /* clear character classes */ + for (i = 0; i < POSIX_SWASH_COUNT; i++) { + SvREFCNT_dec(PL_utf8_swash_ptrs[i]); + PL_utf8_swash_ptrs[i] = NULL; + } SvREFCNT_dec(PL_utf8_mark); SvREFCNT_dec(PL_utf8_toupper); SvREFCNT_dec(PL_utf8_totitle); @@ -1001,16 +991,6 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_utf8_idstart); SvREFCNT_dec(PL_utf8_idcont); SvREFCNT_dec(PL_utf8_foldclosures); - PL_utf8_alnum = NULL; - PL_utf8_alpha = NULL; - PL_utf8_space = NULL; - PL_utf8_graph = NULL; - PL_utf8_digit = NULL; - PL_utf8_upper = NULL; - PL_utf8_lower = NULL; - PL_utf8_print = NULL; - PL_utf8_punct = NULL; - PL_utf8_xdigit = NULL; PL_utf8_mark = NULL; PL_utf8_toupper = NULL; PL_utf8_totitle = NULL; @@ -1019,6 +999,16 @@ perl_destruct(pTHXx) PL_utf8_idstart = NULL; PL_utf8_idcont = NULL; PL_utf8_foldclosures = NULL; + for (i = 0; i < POSIX_CC_COUNT; i++) { + SvREFCNT_dec(PL_Posix_ptrs[i]); + PL_Posix_ptrs[i] = NULL; + + SvREFCNT_dec(PL_L1Posix_ptrs[i]); + PL_L1Posix_ptrs[i] = NULL; + + SvREFCNT_dec(PL_XPosix_ptrs[i]); + PL_XPosix_ptrs[i] = NULL; + } if (!specialWARN(PL_compiling.cop_warnings)) PerlMemShared_free(PL_compiling.cop_warnings); @@ -1026,7 +1016,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 +1051,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 */ @@ -1074,6 +1069,10 @@ perl_destruct(pTHXx) while (sv_clean_all() > 2) ; +#ifdef USE_ITHREADS + Safefree(PL_stashpad); /* must come after sv_clean_all */ +#endif + AvREAL_off(PL_fdpid); /* no surviving entries */ SvREFCNT_dec(PL_fdpid); /* needed in io_close() */ PL_fdpid = NULL; @@ -1152,7 +1151,7 @@ perl_destruct(pTHXx) if (PL_sv_count != 0) { SV* sva; SV* sv; - register SV* svend; + SV* svend; for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) { svend = &sva[SvREFCNT(sva)]; @@ -1205,12 +1204,6 @@ perl_destruct(pTHXx) #endif PL_sv_count = 0; -#ifdef PERL_DEBUG_READONLY_OPS - free(PL_slabs); - PL_slabs = NULL; - PL_slab_count = 0; -#endif - #if defined(PERLIO_LAYERS) /* No more IO - including error messages ! */ PerlIO_cleanup(aTHX); @@ -1225,9 +1218,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(); @@ -1242,10 +1232,9 @@ perl_destruct(pTHXx) PL_psig_pend = (int*)NULL; Safefree(psig_save); } - PL_formfeed = NULL; nuke_stacks(); - PL_tainting = FALSE; - PL_taint_warn = FALSE; + TAINTING_set(FALSE); + TAINT_WARN_set(FALSE); PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */ PL_debug = 0; @@ -1312,8 +1301,7 @@ perl_free(pTHXx) * Don't free thread memory if PERL_DESTRUCT_LEVEL is set to a non-zero * value as we're probably hunting memory leaks then */ - const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"); - if (!s || atoi(s) == 0) { + if (PL_perl_destruct_level == 0) { const U32 old_debug = PL_debug; /* Emulate the PerlHost behaviour of free()ing all memory allocated in this thread at thread exit. */ @@ -1491,23 +1479,21 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) #ifndef MULTIPLICITY PERL_UNUSED_ARG(my_perl); #endif - -#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) - /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0 - * This MUST be done before any hash stores or fetches take place. - * If you set PL_rehash_seed (and presumably also PL_rehash_seed_set) - * yourself, it is your responsibility to provide a good random seed! - * You can also define PERL_HASH_SEED in compile time, see hv.h. */ - if (!PL_rehash_seed_set) - PL_rehash_seed = get_hash_seed(); +#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) || defined(USE_HASH_SEED_DEBUG) { - const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); - - if (s && (atoi(s) == 1)) - PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n", PL_rehash_seed); + const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); + + if (s && (atoi(s) == 1)) { + unsigned char *seed= PERL_HASH_SEED; + unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES; + PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC); + while (seed < seed_end) { + PerlIO_printf(Perl_debug_log, "%02x", *seed++); + } + PerlIO_printf(Perl_debug_log, "\n"); + } } #endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */ - PL_origargc = argc; PL_origargv = argv; @@ -1609,7 +1595,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) PL_do_undump = FALSE; cxstack_ix = -1; /* start label stack again */ init_ids(); - assert (!PL_tainted); + assert (!TAINT_get); TAINT; S_set_caret_X(aTHX); TAINT_NOT; @@ -1685,7 +1671,7 @@ S_Internals_V(pTHX_ CV *cv) #endif const int entries = 3 + local_patch_count; int i; - static char non_bincompat_options[] = + static const char non_bincompat_options[] = # ifdef DEBUGGING " DEBUGGING" # endif @@ -1795,20 +1781,18 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) char **argv = PL_origargv; const char *scriptname = NULL; VOL bool dosearch = FALSE; - register char c; + char c; bool doextract = FALSE; const char *cddir = NULL; #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(); { @@ -1849,17 +1833,31 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) break; case 't': +#if SILENT_NO_TAINT_SUPPORT + /* silently ignore */ +#elif NO_TAINT_SUPPORT + Perl_croak("This perl was compiled without taint support. " + "Cowardly refusing to run with -t or -T flags"); +#else CHECK_MALLOC_TOO_LATE_FOR('t'); - if( !PL_tainting ) { - PL_taint_warn = TRUE; - PL_tainting = TRUE; + if( !TAINTING_get ) { + TAINT_WARN_set(TRUE); + TAINTING_set(TRUE); } +#endif s++; goto reswitch; case 'T': +#if SILENT_NO_TAINT_SUPPORT + /* silently ignore */ +#elif NO_TAINT_SUPPORT + Perl_croak("This perl was compiled without taint support. " + "Cowardly refusing to run with -t or -T flags"); +#else CHECK_MALLOC_TOO_LATE_FOR('T'); - PL_tainting = TRUE; - PL_taint_warn = FALSE; + TAINTING_set(TRUE); + TAINT_WARN_set(FALSE); +#endif s++; goto reswitch; @@ -1960,16 +1958,23 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) if ( #ifndef SECURE_INTERNAL_GETENV - !PL_tainting && + !TAINTING_get && #endif (s = PerlEnv_getenv("PERL5OPT"))) { while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') { +#if SILENT_NO_TAINT_SUPPORT + /* silently ignore */ +#elif NO_TAINT_SUPPORT + Perl_croak("This perl was compiled without taint support. " + "Cowardly refusing to run with -t or -T flags"); +#else CHECK_MALLOC_TOO_LATE_FOR('T'); - PL_tainting = TRUE; - PL_taint_warn = FALSE; + TAINTING_set(TRUE); + TAINT_WARN_set(FALSE); +#endif } else { char *popt_copy = NULL; @@ -1999,10 +2004,17 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } if (*d == 't') { - if( !PL_tainting ) { - PL_taint_warn = TRUE; - PL_tainting = TRUE; +#if SILENT_NO_TAINT_SUPPORT + /* silently ignore */ +#elif NO_TAINT_SUPPORT + Perl_croak("This perl was compiled without taint support. " + "Cowardly refusing to run with -t or -T flags"); +#else + if( !TAINTING_get) { + TAINT_WARN_set(TRUE); + TAINTING_set(TRUE); } +#endif } else { moreswitches(d); } @@ -2013,7 +2025,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) /* Set $^X early so that it can be used for relocatable paths in @INC */ /* and for SITELIB_EXP in USE_SITECUSTOMIZE */ - assert (!PL_tainted); + assert (!TAINT_get); TAINT; S_set_caret_X(aTHX); TAINT_NOT; @@ -2038,17 +2050,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 @@ -2067,16 +2081,19 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) scriptname = "-"; } - assert (!PL_tainted); + assert (!TAINT_get); init_perllib(); { bool suidscript = FALSE; - open_script(scriptname, dosearch, &suidscript, &rsfp); + 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 +2118,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); @@ -2122,7 +2141,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) if (xsinit) (*xsinit)(aTHX); /* in case linked C routines want magical variables */ #ifndef PERL_MICRO -#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC) || defined(SYMBIAN) +#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(SYMBIAN) init_os_extras(); #endif #endif @@ -2205,7 +2224,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #ifdef PERL_MAD { const char *s; - if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) { + if (!TAINTING_get && + (s = PerlEnv_getenv("PERL_XMLDUMP"))) { PL_madskills = 1; PL_minus_c = 1; if (!s || !s[0]) @@ -2228,7 +2248,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } #endif - lex_start(linestr_sv, rsfp, 0); + lex_start(linestr_sv, rsfp, lex_start_flags); + SvREFCNT_dec(linestr_sv); + PL_subname = newSVpvs("main"); if (add_read_e_script) @@ -2348,8 +2370,9 @@ STATIC void S_run_body(pTHX_ I32 oldscope) { dVAR; - DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n", - PL_sawampersand ? "Enabling" : "Omitting")); + DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support (0x%x).\n", + PL_sawampersand ? "Enabling" : "Omitting", + (unsigned int)(PL_sawampersand))); if (!PL_restartop) { #ifdef PERL_MAD @@ -2376,7 +2399,8 @@ S_run_body(pTHX_ I32 oldscope) call_list(oldscope, PL_initav); } #ifdef PERL_DEBUG_READONLY_OPS - Perl_pending_Slabs_to_ro(aTHX); + if (PL_main_root && PL_main_root->op_slabbed) + Slab_to_ro(OpSLAB(PL_main_root)); #endif } @@ -2396,7 +2420,7 @@ S_run_body(pTHX_ I32 oldscope) CALLRUNOPS(aTHX); } my_exit(0); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ } /* @@ -2504,17 +2528,14 @@ 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 this is probably not what they think they're getting. - * It has the same effect as "sub name;", i.e. just a forward - * declaration! */ PERL_ARGS_ASSERT_GET_CVN_FLAGS; + /* 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! */ if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) { - SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8); - return newSUB(start_subparse(FALSE, 0), - newSVOP(OP_CONST, 0, sv), - NULL, NULL); + return newSTUB(gv,0); } if (gv) return GvCVu(gv); @@ -2548,7 +2569,7 @@ Approximate Perl equivalent: C<&{"$sub_name"}(@$argv)>. */ I32 -Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv) +Perl_call_argv(pTHX_ const char *sub_name, I32 flags, char **argv) /* See G_* flags in cop.h */ /* null terminated arg list */ @@ -2648,7 +2669,6 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) } Zero(&myop, 1, LOGOP); - myop.op_next = NULL; if (!(flags & G_NOARGS)) myop.op_flags |= OPf_STACKED; myop.op_flags |= OP_GIMME_REVERSE(flags); @@ -2667,11 +2687,11 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) * curstash may be meaningless. */ && (SvTYPE(sv) != SVt_PVCV || CvSTASH((const CV *)sv) != PL_debstash) && !(flags & G_NODEBUG)) - PL_op->op_private |= OPpENTERSUB_DB; + myop.op_private |= OPpENTERSUB_DB; if (flags & G_METHOD) { Zero(&method_op, 1, UNOP); - method_op.op_next = PL_op; + method_op.op_next = (OP*)&myop; method_op.op_ppaddr = PL_ppaddr[OP_METHOD]; method_op.op_type = OP_METHOD; myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB]; @@ -2711,7 +2731,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) FREETMPS; JMPENV_POP; my_exit_jump(); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ case 3: if (PL_restartop) { PL_restartjmpenv = NULL; @@ -2778,17 +2798,18 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) SAVEOP(); PL_op = (OP*)&myop; - Zero(PL_op, 1, UNOP); + Zero(&myop, 1, UNOP); EXTEND(PL_stack_sp, 1); *++PL_stack_sp = sv; if (!(flags & G_NOARGS)) myop.op_flags = OPf_STACKED; - myop.op_next = NULL; myop.op_type = OP_ENTEREVAL; 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 */ @@ -2818,7 +2839,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) FREETMPS; JMPENV_POP; my_exit_jump(); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ case 3: if (PL_restartop) { PL_restartjmpenv = NULL; @@ -2860,7 +2881,6 @@ SV* Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error) { dVAR; - dSP; SV* sv = newSVpv(p, 0); PERL_ARGS_ASSERT_EVAL_PV; @@ -2868,12 +2888,18 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error) eval_sv(sv, G_SCALAR); SvREFCNT_dec(sv); - SPAGAIN; - sv = POPs; - PUTBACK; + { + dSP; + sv = POPs; + PUTBACK; + } - if (croak_on_error && SvTRUE(ERRSV)) { - Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV)); + /* just check empty string or undef? */ + if (croak_on_error) { + SV * const errsv = ERRSV; + if(SvTRUE_NN(errsv)) + /* replace with croak_sv? */ + Perl_croak_nocontext("%s", SvPV_nolen_const(errsv)); } return sv; @@ -2985,6 +3011,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) " H Hash dump -- usurps values()\n" " X Scratchpad allocation\n" " D Cleaning up\n" + " S Op slab allocation\n" " T Tokenising\n" " R Include reference counts of dumped variables (eg when using -Ds)\n", " J Do not s,t,P-debug (Jump over) opcodes within package DB\n" @@ -3004,7 +3031,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) /* if adding extra options, remember to update DEBUG_MASK */ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB"; - for (; isALNUM(**s); (*s)++) { + for (; isWORDCHAR(**s); (*s)++) { const char * const d = strchr(debopts,**s); if (d) i |= 1 << (d - debopts); @@ -3015,7 +3042,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) } else if (isDIGIT(**s)) { i = atoi(*s); - for (; isALNUM(**s); (*s)++) ; + for (; isWORDCHAR(**s); (*s)++) ; } else if (givehelp) { const char *const *p = usage_msgd; @@ -3109,7 +3136,7 @@ Perl_moreswitches(pTHX_ const char *s) s++; /* -dt indicates to the debugger that threads will be used */ - if (*s == 't' && !isALNUM(s[1])) { + if (*s == 't' && !isWORDCHAR(s[1])) { ++s; my_setenv("PERL5DB_THREADED", "1"); } @@ -3132,7 +3159,7 @@ Perl_moreswitches(pTHX_ const char *s) end = s + strlen(s); /* We now allow -d:Module=Foo,Bar and -d:-Module */ - while(isALNUM(*s) || *s==':') ++s; + while(isWORDCHAR(*s) || *s==':') ++s; if (*s != '=') sv_catpvn(sv, start, end - start); else { @@ -3160,7 +3187,7 @@ Perl_moreswitches(pTHX_ const char *s) if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n"); - for (s++; isALNUM(*s); s++) ; + for (s++; isWORDCHAR(*s); s++) ; #endif return s; } @@ -3253,7 +3280,7 @@ Perl_moreswitches(pTHX_ const char *s) sv = newSVpvn(use,4); start = s; /* We allow -M'Module qw(Foo Bar)' */ - while(isALNUM(*s) || *s==':') { + while(isWORDCHAR(*s) || *s==':') { if( *s++ == ':' ) { if( *s == ':' ) s++; @@ -3305,8 +3332,15 @@ Perl_moreswitches(pTHX_ const char *s) return s; case 't': case 'T': - if (!PL_tainting) +#if SILENT_NO_TAINT_SUPPORT + /* silently ignore */ +#elif NO_TAINT_SUPPORT + Perl_croak("This perl was compiled without taint support. " + "Cowardly refusing to run with -t or -T flags"); +#else + if (!TAINTING_get) TOO_LATE_FOR(*s); +#endif s++; return s; case 'u': @@ -3376,6 +3410,7 @@ Perl_moreswitches(pTHX_ const char *s) STATIC void S_minus_v(pTHX) { + PerlIO * PIO_stdout; if (!sv_derived_from(PL_patchlevel, "version")) upg_version(PL_patchlevel, TRUE); #if !defined(DGUX) @@ -3387,16 +3422,22 @@ S_minus_v(pTHX) # else SV *num = newSVpvs(PERL_PATCHNUM); # endif - - if (sv_len(num)>=sv_len(level) && strnEQ(SvPV_nolen(num),SvPV_nolen(level),sv_len(level))) { - SvREFCNT_dec(level); - level= num; - } else { - Perl_sv_catpvf(aTHX_ level, " (%"SVf")", num); - SvREFCNT_dec(num); + { + STRLEN level_len, num_len; + char * level_str, * num_str; + num_str = SvPV(num, num_len); + level_str = SvPV(level, level_len); + if (num_len>=level_len && strnEQ(num_str,level_str,level_len)) { + SvREFCNT_dec(level); + level= num; + } else { + Perl_sv_catpvf(aTHX_ level, " (%"SVf")", num); + SvREFCNT_dec(num); + } } #endif - PerlIO_printf(PerlIO_stdout(), + PIO_stdout = PerlIO_stdout(); + PerlIO_printf(PIO_stdout, "\nThis is perl " STRINGIFY(PERL_REVISION) ", version " STRINGIFY(PERL_VERSION) ", subversion " STRINGIFY(PERL_SUBVERSION) @@ -3405,87 +3446,69 @@ S_minus_v(pTHX) SvREFCNT_dec(level); } #else /* DGUX */ + PIO_stdout = PerlIO_stdout(); /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */ - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, Perl_form(aTHX_ "\nThis is perl, %"SVf"\n", SVfARG(vstringify(PL_patchlevel)))); - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, Perl_form(aTHX_ " built under %s at %s %s\n", OSNAME, __DATE__, __TIME__)); - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, Perl_form(aTHX_ " OS Specific Release: %s\n", OSVERS)); #endif /* !DGUX */ #if defined(LOCAL_PATCH_COUNT) if (LOCAL_PATCH_COUNT > 0) - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "\n(with %d registered patch%s, " "see perl -V for more detail)", LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : ""); #endif - PerlIO_printf(PerlIO_stdout(), - "\n\nCopyright 1987-2012, Larry Wall\n"); + PerlIO_printf(PIO_stdout, + "\n\nCopyright 1987-2013, Larry Wall\n"); #ifdef MSDOS - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); #endif #ifdef DJGPP - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n" "djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1999\n"); #endif #ifdef OS2 - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n" "Version 5 port Copyright (c) 1994-2002, Andreas Kaiser, Ilya Zakharevich\n"); #endif -#ifdef atarist - PerlIO_printf(PerlIO_stdout(), - "atariST series port, ++jrb bammi@cadence.com\n"); -#endif -#ifdef __BEOS__ - PerlIO_printf(PerlIO_stdout(), - "BeOS port Copyright Tom Spindler, 1997-1999\n"); -#endif -#ifdef MPE - PerlIO_printf(PerlIO_stdout(), - "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2003\n"); -#endif #ifdef OEMVS - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "MVS (OS390) port by Mortice Kern Systems, 1997-1999\n"); #endif #ifdef __VOS__ - PerlIO_printf(PerlIO_stdout(), - "Stratus VOS port by Paul.Green@stratus.com, 1997-2002\n"); -#endif -#ifdef __OPEN_VM - PerlIO_printf(PerlIO_stdout(), - "VM/ESA port by Neale Ferguson, 1998-1999\n"); + PerlIO_printf(PIO_stdout, + "Stratus OpenVOS port by Paul.Green@stratus.com, 1997-2013\n"); #endif #ifdef POSIX_BC - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n"); #endif -#ifdef EPOC - PerlIO_printf(PerlIO_stdout(), - "EPOC port by Olaf Flebbe, 1999-2002\n"); -#endif #ifdef UNDER_CE - PerlIO_printf(PerlIO_stdout(),"WINCE port by Rainer Keuchel, 2001-2002\n"); - PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n"); + PerlIO_printf(PIO_stdout, + "WINCE port by Rainer Keuchel, 2001-2002\n" + "Built on " __DATE__ " " __TIME__ "\n\n"); wce_hitreturn(); #endif #ifdef __SYMBIAN32__ - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "Symbian port by Nokia, 2004-2005\n"); #endif #ifdef BINARY_BUILD_NOTICE BINARY_BUILD_NOTICE; #endif - PerlIO_printf(PerlIO_stdout(), + PerlIO_printf(PIO_stdout, "\n\ Perl may be copied only under the terms of either the Artistic License or the\n\ GNU General Public License, which may be found in the Perl 5 source kit.\n\n\ @@ -3500,6 +3523,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 +#endif + void Perl_my_unexec(pTHX) { @@ -3518,7 +3545,6 @@ Perl_my_unexec(pTHX) PerlProc_exit(status); #else # ifdef VMS -# include lib$signal(SS$_DEBUG); /* ssdef.h #included from vmsish.h */ # elif defined(WIN32) || defined(__CYGWIN__) Perl_croak(aTHX_ "dump is not supported"); @@ -3614,12 +3640,13 @@ S_init_main_stash(pTHX) sv_setpvs(get_sv("/", GV_ADD), "\n"); } -STATIC int -S_open_script(pTHX_ const char *scriptname, bool dosearch, - bool *suidscript, PerlIO **rsfpp) +STATIC PerlIO * +S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) { int fdscript = -1; + PerlIO *rsfp = NULL; dVAR; + Stat_t tmpstatbuf; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3668,16 +3695,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, if (*PL_origfilename == '-' && PL_origfilename[1] == '\0') scriptname = (char *)""; if (fdscript >= 0) { - *rsfpp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE); -# if defined(HAS_FCNTL) && defined(F_SETFD) - if (*rsfpp) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1); -# endif + rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE); } else if (!*scriptname) { forbid_setid(0, *suidscript); - *rsfpp = PerlIO_stdin(); + return NULL; } else { #ifdef FAKE_BIT_BUCKET @@ -3712,7 +3734,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, #endif } #endif - *rsfpp = PerlIO_open(scriptname,PERL_SCRIPT_MODE); + rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE); #ifdef FAKE_BIT_BUCKET if (memEQ(scriptname, FAKE_BIT_BUCKET_PREFIX, sizeof(FAKE_BIT_BUCKET_PREFIX) - 1) @@ -3721,13 +3743,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, } scriptname = BIT_BUCKET; #endif -# if defined(HAS_FCNTL) && defined(F_SETFD) - if (*rsfpp) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1); -# endif } - if (!*rsfpp) { + if (!rsfp) { /* PSz 16 Sep 03 Keep neat error message */ if (PL_e_script) Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno)); @@ -3735,7 +3752,18 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } - return fdscript; +#if defined(HAS_FCNTL) && defined(F_SETFD) + /* ensure close-on-exec */ + fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); +#endif + + if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode)) + Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", + CopFILE(PL_curcop), + strerror(EISDIR)); + + return rsfp; } /* Mention @@ -3752,13 +3780,13 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, STATIC void S_validate_suid(pTHX_ PerlIO *rsfp) { - PERL_ARGS_ASSERT_VALIDATE_SUID; - const UV my_uid = PerlProc_getuid(); const UV my_euid = PerlProc_geteuid(); const UV my_gid = PerlProc_getgid(); const UV my_egid = PerlProc_getegid(); + PERL_ARGS_ASSERT_VALIDATE_SUID; + if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; @@ -3780,7 +3808,7 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) { dVAR; const char *s; - register const char *s2; + const char *s2; PERL_ARGS_ASSERT_FIND_BEGINNING; @@ -3808,6 +3836,9 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) STATIC void S_init_ids(pTHX) { + /* no need to do anything here any more if we don't + * do tainting. */ +#if !NO_TAINT_SUPPORT dVAR; const UV my_uid = PerlProc_getuid(); const UV my_euid = PerlProc_geteuid(); @@ -3816,7 +3847,8 @@ S_init_ids(pTHX) /* Should not happen: */ CHECK_MALLOC_TAINT(my_uid && (my_euid != my_uid || my_egid != my_gid)); - PL_tainting |= (my_uid && (my_euid != my_uid || my_egid != my_gid)); + TAINTING_set( TAINTING_get | (my_uid && (my_euid != my_uid || my_egid != my_gid)) ); +#endif /* BUG */ /* PSz 27 Feb 04 * Should go by suidscript, not uid!=euid: why disallow @@ -4098,7 +4130,7 @@ S_init_predump_symbols(pTHX) } void -Perl_init_argv_symbols(pTHX_ register int argc, register char **argv) +Perl_init_argv_symbols(pTHX_ int argc, char **argv) { dVAR; @@ -4138,19 +4170,24 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv) (void)sv_utf8_decode(sv); } } + + if (PL_inplace && (!PL_argvgv || AvFILL(GvAV(PL_argvgv)) == -1)) + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "-i used with no filenames on the command line, " + "reading from STDIN"); } STATIC void -S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env) +S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env) { dVAR; GV* tmpgv; PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS; - PL_toptarget = newSV_type(SVt_PVFM); + PL_toptarget = newSV_type(SVt_PVIV); sv_setpvs(PL_toptarget, ""); - PL_bodytarget = newSV_type(SVt_PVFM); + PL_bodytarget = newSV_type(SVt_PVIV); sv_setpvs(PL_bodytarget, ""); PL_formtarget = PL_bodytarget; @@ -4228,7 +4265,7 @@ S_init_perllib(pTHX) STRLEN len; #endif - if (!PL_tainting) { + if (!TAINTING_get) { #ifndef VMS perl5lib = PerlEnv_getenv("PERL5LIB"); /* @@ -4344,7 +4381,7 @@ S_init_perllib(pTHX) |INCPUSH_CAN_RELOCATE); #endif - if (!PL_tainting) { + if (!TAINTING_get) { #ifndef VMS /* * It isn't possible to delete an environment variable with @@ -4401,11 +4438,11 @@ S_init_perllib(pTHX) #endif #endif /* !PERL_IS_MINIPERL */ - if (!PL_tainting) + if (!TAINTING_get) S_incpush(aTHX_ STR_WITH_LEN("."), 0); } -#if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__) +#if defined(DOSISH) || defined(__SYMBIAN32__) # define PERLLIB_SEP ';' #else # if defined(VMS) @@ -4451,16 +4488,12 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) PERL_ARGS_ASSERT_MAYBERELOCATE; assert(len > 0); - if (len) { - /* I am not convinced that this is valid when PERLLIB_MANGLE is - defined to so something (in os2/os2.c), but the code has been - this way, ignoring any possible changed of length, since - 760ac839baf413929cd31cc32ffd6dba6b781a81 (5.003_02) so I'll leave - it be. */ - libdir = newSVpvn(PERLLIB_MANGLE(dir, len), len); - } else { - libdir = newSVpv(PERLLIB_MANGLE(dir, 0), 0); - } + /* I am not convinced that this is valid when PERLLIB_MANGLE is + defined to so something (in os2/os2.c), but the code has been + this way, ignoring any possible changed of length, since + 760ac839baf413929cd31cc32ffd6dba6b781a81 (5.003_02) so I'll leave + it be. */ + libdir = newSVpvn(PERLLIB_MANGLE(dir, len), len); #ifdef VMS { @@ -4567,7 +4600,7 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) SvREFCNT_dec(libdir); /* And this is the new libdir. */ libdir = tempsv; - if (PL_tainting && + if (TAINTING_get && (PerlProc_getuid() != PerlProc_geteuid() || PerlProc_getgid() != PerlProc_getegid())) { /* Need to taint relocated paths if running set ID */ @@ -4817,7 +4850,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) CopLINE_set(PL_curcop, oldline); JMPENV_POP; my_exit_jump(); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ case 3: if (PL_restartop) { PL_curcop = &PL_compiling; @@ -4977,8 +5010,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: */