X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4bb78d633325d95f788c504d75b0fcae3fbc9f46..dc4b20bdf34f180d3017bda09b1fd225ad2b19d4:/perl.c?ds=sidebyside diff --git a/perl.c b/perl.c index 74e7470..65b0a1c 100644 --- a/perl.c +++ b/perl.c @@ -2,7 +2,7 @@ /* perl.c * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 - * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 + * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 * by Larry Wall and others * * You may distribute under the terms of either the GNU General Public @@ -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 */ 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) \ @@ -92,7 +90,7 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen); #define CALL_LIST_BODY(cv) \ PUSHMARK(PL_stack_sp); \ - call_sv(MUTABLE_SV((cv)), G_EVAL|G_DISCARD); + call_sv(MUTABLE_SV((cv)), G_EVAL|G_DISCARD|G_VOID); static void S_init_tls_and_interp(PerlInterpreter *my_perl) @@ -105,6 +103,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl) ALLOC_THREAD_KEY; PERL_SET_THX(my_perl); OP_REFCNT_INIT; + OP_CHECK_MUTEX_INIT; HINTS_REFCNT_INIT; MUTEX_INIT(&PL_dollarzero_mutex); MUTEX_INIT(&PL_my_ctx_mutex); @@ -243,29 +242,7 @@ 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; @@ -308,6 +285,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); @@ -737,10 +715,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 */ @@ -829,7 +807,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; @@ -841,11 +818,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; @@ -984,6 +969,7 @@ perl_destruct(pTHXx) /* clear utf8 character classes */ SvREFCNT_dec(PL_utf8_alnum); SvREFCNT_dec(PL_utf8_alpha); + SvREFCNT_dec(PL_utf8_blank); SvREFCNT_dec(PL_utf8_space); SvREFCNT_dec(PL_utf8_graph); SvREFCNT_dec(PL_utf8_digit); @@ -1002,6 +988,7 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_utf8_foldclosures); PL_utf8_alnum = NULL; PL_utf8_alpha = NULL; + PL_utf8_blank = NULL; PL_utf8_space = NULL; PL_utf8_graph = NULL; PL_utf8_digit = NULL; @@ -1025,7 +1012,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. */ @@ -1061,6 +1047,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 */ @@ -1204,12 +1196,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); @@ -1224,9 +1210,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(); @@ -1715,6 +1698,9 @@ S_Internals_V(pTHX_ CV *cv) # ifdef PERL_PRESERVE_IVUV " PERL_PRESERVE_IVUV" # endif +# ifdef PERL_RELOCATABLE_INCPUSH + " PERL_RELOCATABLE_INCPUSH" +# endif # ifdef PERL_USE_DEVEL " PERL_USE_DEVEL" # endif @@ -1797,14 +1783,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(); { @@ -2034,17 +2018,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 @@ -2069,10 +2055,13 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { 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) @@ -2097,6 +2086,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); @@ -2201,7 +2192,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #ifdef PERL_MAD { const char *s; - if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) { + if (!PL_tainting && + (s = PerlEnv_getenv("PERL_XMLDUMP"))) { PL_madskills = 1; PL_minus_c = 1; if (!s || !s[0]) @@ -2224,7 +2216,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) @@ -2330,7 +2325,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; @@ -2372,7 +2367,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 } @@ -2392,7 +2388,7 @@ S_run_body(pTHX_ I32 oldscope) CALLRUNOPS(aTHX); } my_exit(0); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ } /* @@ -2500,17 +2496,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); @@ -2707,7 +2700,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; @@ -2785,6 +2778,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 */ @@ -2814,7 +2809,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; @@ -2981,6 +2976,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" @@ -3422,7 +3418,7 @@ S_minus_v(pTHX) #endif PerlIO_printf(PerlIO_stdout(), - "\n\nCopyright 1987-2011, Larry Wall\n"); + "\n\nCopyright 1987-2012, Larry Wall\n"); #ifdef MSDOS PerlIO_printf(PerlIO_stdout(), "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); @@ -3437,10 +3433,6 @@ S_minus_v(pTHX) "\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"); @@ -3496,6 +3488,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) { @@ -3514,7 +3510,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"); @@ -3610,11 +3605,11 @@ 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; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3664,16 +3659,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 @@ -3708,7 +3698,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) @@ -3717,13 +3707,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)); @@ -3731,7 +3716,11 @@ 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 + return rsfp; } /* Mention @@ -3748,15 +3737,20 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, STATIC void S_validate_suid(pTHX_ PerlIO *rsfp) { + 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 (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */ + if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ 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) + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) || - (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ @@ -3800,17 +3794,14 @@ STATIC void S_init_ids(pTHX) { dVAR; - PL_uid = PerlProc_getuid(); - PL_euid = PerlProc_geteuid(); - PL_gid = PerlProc_getgid(); - PL_egid = PerlProc_getegid(); -#ifdef VMS - PL_uid |= PL_gid << 16; - PL_euid |= PL_egid << 16; -#endif + const UV my_uid = PerlProc_getuid(); + const UV my_euid = PerlProc_geteuid(); + const UV my_gid = PerlProc_getgid(); + const UV my_egid = PerlProc_getegid(); + /* Should not happen: */ - CHECK_MALLOC_TAINT(PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); - PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); + 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)); /* BUG */ /* PSz 27 Feb 04 * Should go by suidscript, not uid!=euid: why disallow @@ -3876,9 +3867,9 @@ S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */ } #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW - if (PL_euid != PL_uid) + if (PerlProc_getuid() != PerlProc_geteuid()) Perl_croak(aTHX_ "No %s allowed while running setuid", message); - if (PL_egid != PL_gid) + if (PerlProc_getgid() != PerlProc_getegid()) Perl_croak(aTHX_ "No %s allowed while running setgid", message); #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */ if (suidscript) @@ -4088,7 +4079,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 @@ -4132,6 +4123,11 @@ 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 @@ -4142,9 +4138,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register 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; @@ -4203,9 +4199,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register #endif /* !PERL_MICRO */ } TAINT_NOT; -#ifdef THREADS_HAVE_PIDS - PL_ppid = (IV)getppid(); -#endif /* touch @F array to prevent spurious warnings 20020415 MJD */ if (PL_minus_a) { @@ -4565,7 +4558,8 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags) /* And this is the new libdir. */ libdir = tempsv; if (PL_tainting && - (PL_uid != PL_euid || PL_gid != PL_egid)) { + (PerlProc_getuid() != PerlProc_geteuid() || + PerlProc_getgid() != PerlProc_getegid())) { /* Need to taint relocated paths if running set ID */ SvTAINTED_on(libdir); } @@ -4813,14 +4807,14 @@ 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; 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; } @@ -4973,8 +4967,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: */