#include <unistd.h>
#endif
-#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
+#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) && !defined(PERL_MICRO)
char *getenv (char *); /* Usually in <stdlib.h> */
#endif
#else
/*
+=head1 Embedding Functions
+
=for apidoc perl_alloc
Allocates a new Perl interpreter. See L<perlembed>.
sys_intern_init();
#endif
- PerlIO_init(); /* Hook to IO system */
+ PerlIO_init(aTHX); /* Hook to IO system */
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
DEBUG_P(debprofdump());
+#if defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
/* The exit() function will do everything that needs doing. */
return STATUS_NATIVE_EXPORT;;
}
/* jettison our possibly duplicated environment */
-
-#ifdef USE_ENVIRON_ARRAY
+ /* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied
+ * so we certainly shouldn't free it here
+ */
+#if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
if (environ != PL_origenviron) {
I32 i;
* flag is set in regexec.c:S_regtry
*/
SvFLAGS(resv) &= ~SVf_BREAK;
- }
+ }
else if(SvREPADTMP(resv)) {
SvREPADTMP_off(resv);
}
SvREFCNT_dec(PL_utf8_xdigit);
SvREFCNT_dec(PL_utf8_mark);
SvREFCNT_dec(PL_utf8_toupper);
+ SvREFCNT_dec(PL_utf8_totitle);
SvREFCNT_dec(PL_utf8_tolower);
+ SvREFCNT_dec(PL_utf8_tofold);
PL_utf8_alnum = Nullsv;
PL_utf8_alnumc = Nullsv;
PL_utf8_ascii = Nullsv;
PL_utf8_toupper = Nullsv;
PL_utf8_totitle = Nullsv;
PL_utf8_tolower = Nullsv;
+ PL_utf8_tofold = Nullsv;
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
if (!specialCopIO(PL_compiling.cop_io))
SvREFCNT_dec(PL_compiling.cop_io);
PL_compiling.cop_io = Nullsv;
-#ifdef USE_ITHREADS
- Safefree(CopFILE(&PL_compiling));
- CopFILE(&PL_compiling) = Nullch;
- Safefree(CopSTASHPV(&PL_compiling));
-#else
- SvREFCNT_dec(CopFILEGV(&PL_compiling));
- CopFILEGV(&PL_compiling) = Nullgv;
- /* cop_stash is not refcounted */
-#endif
+ CopFILE_free(&PL_compiling);
+ CopSTASH_free(&PL_compiling);
/* Prepare to destruct main symbol table. */
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
+#if defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
Safefree(PL_origfilename);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
# else
void *host = w32_internal_host;
# endif
-# ifndef NETWARE
- if (PerlProc_lasthost()) {
-# ifdef USE_PERLIO
- PerlIO_cleanup();
-# endif
- }
-# endif
PerlMem_free(aTHXx);
# ifdef NETWARE
nw5_delete_internal_host(host);
win32_delete_internal_host(host);
# endif
# else
-# ifdef USE_PERLIO
- PerlIO_cleanup();
-# endif
PerlMem_free(aTHXx);
# endif
#else
{
/* we copy rather than point to argv
* since perl_clone will copy and perl_destruct
- * has no way of knowing if we've made a copy or
+ * has no way of knowing if we've made a copy or
* just point to argv
*/
int i = PL_origargc;
goto reswitch;
break;
+ case 't':
+ if( !PL_tainting ) {
+ PL_taint_warn = TRUE;
+ PL_tainting = TRUE;
+ }
+ s++;
+ goto reswitch;
case 'T':
PL_tainting = TRUE;
+ PL_taint_warn = FALSE;
s++;
goto reswitch;
char *popt = s;
while (isSPACE(*s))
s++;
- if (*s == '-' && *(s+1) == 'T')
+ if (*s == '-' && *(s+1) == 'T') {
PL_tainting = TRUE;
+ PL_taint_warn = FALSE;
+ }
else {
char *popt_copy = Nullch;
while (s && *s) {
d = s;
if (!*s)
break;
- if (!strchr("DIMUdmw", *s))
+ if (!strchr("DIMUdmtw", *s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
while (++s && *s) {
if (isSPACE(*s)) {
break;
}
}
- moreswitches(d);
+ if (*d == 't') {
+ if( !PL_tainting ) {
+ PL_taint_warn = TRUE;
+ PL_tainting = TRUE;
+ }
+ } else {
+ moreswitches(d);
+ }
}
}
}
+ if (PL_taint_warn && PL_dowarn != G_WARN_ALL_OFF) {
+ PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+ }
+
if (!scriptname)
scriptname = argv[0];
if (PL_e_script) {
#endif
oldscope = PL_scopestack_ix;
+#ifdef VMS
+ VMSISH_HUSHED = 0;
+#endif
#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
+ if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
#ifdef MYMALLOC
}
/*
+=head1 SV Manipulation Functions
+
=for apidoc p||get_sv
Returns the SV of the specified Perl scalar. If C<create> is set and the
}
/*
+=head1 Array Manipulation Functions
+
=for apidoc p||get_av
Returns the AV of the specified Perl array. If C<create> is set and the
}
/*
+=head1 Hash Manipulation Functions
+
=for apidoc p||get_hv
Returns the HV of the specified Perl hash. If C<create> is set and the
}
/*
+=head1 CV Manipulation Functions
+
=for apidoc p||get_cv
Returns the CV of the specified Perl subroutine. If C<create> is set and
/* Be sure to refetch the stack pointer after calling these routines. */
/*
+
+=head1 Callback Functions
+
=for apidoc p||call_argv
Performs a callback to the specified Perl sub. See L<perlcall>.
/* Require a module. */
/*
+=head1 Embedding Functions
+
=for apidoc p||require_pv
Tells Perl to C<require> the file named by the string argument. It is
return s;
case 'F':
PL_minus_F = TRUE;
- PL_splitstr = savepv(s + 1);
- s += strlen(s);
+ PL_splitstr = ++s;
+ while (*s && !isSPACE(*s)) ++s;
+ *s = '\0';
+ PL_splitstr = savepv(PL_splitstr);
return s;
case 'a':
PL_minus_a = TRUE;
s++;
}
return s;
- case 'I': /* -I handled both here and in parse_perl() */
+ case 'I': /* -I handled both here and in parse_body() */
forbid_setid("-I");
++s;
while (*s && isSPACE(*s))
PL_doswitches = TRUE;
s++;
return s;
+ case 't':
+ if (!PL_tainting)
+ Perl_croak(aTHX_ "Too late for \"-t\" option");
+ s++;
+ return s;
case 'T':
if (!PL_tainting)
Perl_croak(aTHX_ "Too late for \"-T\" option");
"\n\nCopyright 1987-2001, Larry Wall\n");
#ifdef MACOS_TRADITIONAL
PerlIO_printf(PerlIO_stdout(),
- "\nMac OS port Copyright (c) 1991-2001, Matthias Neeracher\n");
+ "\nMac OS port Copyright 1991-2001, Matthias Neeracher;\n"
+ "maintained by Chris Nandor\n");
#endif
#ifdef MSDOS
PerlIO_printf(PerlIO_stdout(),
return s;
case 'W':
PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
+ if (!specialWARN(PL_compiling.cop_warnings))
+ SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = pWARN_ALL ;
s++;
return s;
case 'X':
PL_dowarn = G_WARN_ALL_OFF;
+ if (!specialWARN(PL_compiling.cop_warnings))
+ SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = pWARN_NONE ;
s++;
return s;
STATIC void
S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
{
+ char *quote;
+ char *code;
+ char *cpp_discard_flag;
+ char *perl;
+
*fdscript = -1;
if (PL_e_script) {
}
}
-#ifdef USE_ITHREADS
- Safefree(CopFILE(PL_curcop));
-#else
- SvREFCNT_dec(CopFILEGV(PL_curcop));
-#endif
+ CopFILE_free(PL_curcop);
CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
if (*fdscript >= 0) {
PL_rsfp = PerlIO_fdopen(*fdscript,PERL_SCRIPT_MODE);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
- if (PL_rsfp)
- fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1); /* ensure close-on-exec */
-#endif
+# if defined(HAS_FCNTL) && defined(F_SETFD)
+ if (PL_rsfp)
+ /* ensure close-on-exec */
+ fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
+# endif
}
else if (PL_preprocess) {
char *cpp_cfg = CPPSTDIN;
Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
sv_catpv(cpp, cpp_cfg);
- sv_catpvn(sv, "-I", 2);
- sv_catpv(sv,PRIVLIB_EXP);
+# ifndef VMS
+ sv_catpvn(sv, "-I", 2);
+ sv_catpv(sv,PRIVLIB_EXP);
+# endif
DEBUG_P(PerlIO_printf(Perl_debug_log,
"PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
scriptname, SvPVX (cpp), SvPVX (sv), CPPMINUS));
-#if defined(MSDOS) || defined(WIN32)
- Perl_sv_setpvf(aTHX_ cmd, "\
-sed %s -e \"/^[^#]/b\" \
- -e \"/^#[ ]*include[ ]/b\" \
- -e \"/^#[ ]*define[ ]/b\" \
- -e \"/^#[ ]*if[ ]/b\" \
- -e \"/^#[ ]*ifdef[ ]/b\" \
- -e \"/^#[ ]*ifndef[ ]/b\" \
- -e \"/^#[ ]*else/b\" \
- -e \"/^#[ ]*elif[ ]/b\" \
- -e \"/^#[ ]*undef[ ]/b\" \
- -e \"/^#[ ]*endif/b\" \
- -e \"s/^#.*//\" \
- %s | %"SVf" -C %"SVf" %s",
- (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
-#else
-# ifdef __OPEN_VM
- Perl_sv_setpvf(aTHX_ cmd, "\
-%s %s -e '/^[^#]/b' \
- -e '/^#[ ]*include[ ]/b' \
- -e '/^#[ ]*define[ ]/b' \
- -e '/^#[ ]*if[ ]/b' \
- -e '/^#[ ]*ifdef[ ]/b' \
- -e '/^#[ ]*ifndef[ ]/b' \
- -e '/^#[ ]*else/b' \
- -e '/^#[ ]*elif[ ]/b' \
- -e '/^#[ ]*undef[ ]/b' \
- -e '/^#[ ]*endif/b' \
- -e 's/^[ ]*#.*//' \
- %s | %"SVf" %"SVf" %s",
-# else
- Perl_sv_setpvf(aTHX_ cmd, "\
-%s %s -e '/^[^#]/b' \
- -e '/^#[ ]*include[ ]/b' \
- -e '/^#[ ]*define[ ]/b' \
- -e '/^#[ ]*if[ ]/b' \
- -e '/^#[ ]*ifdef[ ]/b' \
- -e '/^#[ ]*ifndef[ ]/b' \
- -e '/^#[ ]*else/b' \
- -e '/^#[ ]*elif[ ]/b' \
- -e '/^#[ ]*undef[ ]/b' \
- -e '/^#[ ]*endif/b' \
- -e 's/^[ ]*#.*//' \
- %s | %"SVf" -C %"SVf" %s",
-# endif
-#ifdef LOC_SED
- LOC_SED,
-#else
- "sed",
-#endif
- (PL_doextract ? "-e '1,/^#/d\n'" : ""),
-#endif
- scriptname, cpp, sv, CPPMINUS);
+
+# if defined(MSDOS) || defined(WIN32) || defined(VMS)
+ quote = "\"";
+# else
+ quote = "'";
+# endif
+
+# ifdef VMS
+ cpp_discard_flag = "";
+# else
+ cpp_discard_flag = "-C";
+# endif
+
+# ifdef OS2
+ perl = os2_execname(aTHX);
+# else
+ perl = PL_origargv[0];
+# endif
+
+
+ /* This strips off Perl comments which might interfere with
+ the C pre-processor, including #!. #line directives are
+ deliberately stripped to avoid confusion with Perl's version
+ of #line. FWP played some golf with it so it will fit
+ into VMS's 255 character buffer.
+ */
+ if( PL_doextract )
+ code = "(1../^#!.*perl/i)|/^\\s*#(?!\\s*((ifn?|un)def|(el|end)?if|define|include|else|error|pragma)\\b)/||!($|=1)||print";
+ else
+ code = "/^\\s*#(?!\\s*((ifn?|un)def|(el|end)?if|define|include|else|error|pragma)\\b)/||!($|=1)||print";
+
+ Perl_sv_setpvf(aTHX_ cmd, "\
+%s -ne%s%s%s %s | %"SVf" %s %"SVf" %s",
+ perl, quote, code, quote, scriptname, cpp,
+ cpp_discard_flag, sv, CPPMINUS);
+
PL_doextract = FALSE;
-#ifdef IAMSUID /* actually, this is caught earlier */
- if (PL_euid != PL_uid && !PL_euid) { /* if running suidperl */
-#ifdef HAS_SETEUID
- (void)seteuid(PL_uid); /* musn't stay setuid root */
-#else
-#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)-1, PL_uid);
-#else
-#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1, PL_uid, (Uid_t)-1);
-#else
- PerlProc_setuid(PL_uid);
-#endif
-#endif
-#endif
+# ifdef IAMSUID /* actually, this is caught earlier */
+ if (PL_euid != PL_uid && !PL_euid) { /* if running suidperl */
+# ifdef HAS_SETEUID
+ (void)seteuid(PL_uid); /* musn't stay setuid root */
+# else
+# ifdef HAS_SETREUID
+ (void)setreuid((Uid_t)-1, PL_uid);
+# else
+# ifdef HAS_SETRESUID
+ (void)setresuid((Uid_t)-1, PL_uid, (Uid_t)-1);
+# else
+ PerlProc_setuid(PL_uid);
+# endif
+# endif
+# endif
if (PerlProc_geteuid() != PL_uid)
Perl_croak(aTHX_ "Can't do seteuid!\n");
}
-#endif /* IAMSUID */
+# endif /* IAMSUID */
+
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "PL_preprocess: cmd=\"%s\"\n",
+ SvPVX(cmd)));
+
PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
SvREFCNT_dec(cmd);
SvREFCNT_dec(cpp);
}
else {
PL_rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
- if (PL_rsfp)
- fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1); /* ensure close-on-exec */
-#endif
+# if defined(HAS_FCNTL) && defined(F_SETFD)
+ if (PL_rsfp)
+ /* ensure close-on-exec */
+ fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
+# endif
}
if (!PL_rsfp) {
-#ifdef DOSUID
-#ifndef IAMSUID /* in case script is not readable before setuid */
- if (PL_euid &&
- PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 &&
- PL_statbuf.st_mode & (S_ISUID|S_ISGID))
- {
- /* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION), PL_origargv);
- Perl_croak(aTHX_ "Can't do setuid\n");
- }
-#endif
-#endif
-#ifdef IAMSUID
- errno = EPERM;
- Perl_croak(aTHX_ "Can't open perl script: %s\n",
- Strerror(errno));
-#else
- Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
- CopFILE(PL_curcop), Strerror(errno));
-#endif
+# ifdef DOSUID
+# ifndef IAMSUID /* in case script is not readable before setuid */
+ if (PL_euid &&
+ PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 &&
+ PL_statbuf.st_mode & (S_ISUID|S_ISGID))
+ {
+ /* try again */
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT,
+ BIN_EXP, (int)PERL_REVISION,
+ (int)PERL_VERSION,
+ (int)PERL_SUBVERSION), PL_origargv);
+ Perl_croak(aTHX_ "Can't do setuid\n");
+ }
+# endif
+# endif
+# ifdef IAMSUID
+ errno = EPERM;
+ Perl_croak(aTHX_ "Can't open perl script: %s\n",
+ Strerror(errno));
+# else
+ Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+ CopFILE(PL_curcop), Strerror(errno));
+# endif
}
}
PL_osname = savepv(OSNAME);
}
-STATIC void
-S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
+void
+Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
{
char *s;
- SV *sv;
- GV* tmpgv;
-#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
- char **dup_env_base = 0;
- int dup_env_count = 0;
-#endif
-
argc--,argv++; /* skip name of script */
if (PL_doswitches) {
for (; argc > 0 && **argv == '-'; argc--,argv++) {
sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
}
}
+ if ((PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV))) {
+ GvMULTI_on(PL_argvgv);
+ (void)gv_AVadd(PL_argvgv);
+ av_clear(GvAVn(PL_argvgv));
+ for (; argc > 0; argc--,argv++) {
+ SV *sv = newSVpv(argv[0],0);
+ av_push(GvAVn(PL_argvgv),sv);
+ if (PL_widesyscalls)
+ (void)sv_utf8_decode(sv);
+ }
+ }
+}
+
+#ifdef HAS_PROCSELFEXE
+/* This is a function so that we don't hold on to MAXPATHLEN
+ bytes of stack longer than necessary
+ */
+STATIC void
+S_procself_val(pTHX_ SV *sv, char *arg0)
+{
+ char buf[MAXPATHLEN];
+ int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+ if (len > 0) {
+ sv_setpvn(sv,buf,len);
+ }
+ else {
+ sv_setpv(sv,arg0);
+ }
+}
+#endif /* HAS_PROCSELFEXE */
+
+STATIC void
+S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
+{
+ char *s;
+ SV *sv;
+ GV* tmpgv;
+
PL_toptarget = NEWSV(0,0);
sv_upgrade(PL_toptarget, SVt_PVFM);
sv_setpvn(PL_toptarget, "", 0);
PL_formtarget = PL_bodytarget;
TAINT;
+
+ init_argv_symbols(argc,argv);
+
if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {
#ifdef MACOS_TRADITIONAL
/* $0 is not majick on a Mac */
magicname("0", "0", 1);
#endif
}
- if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)))
+ if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
+#ifdef HAS_PROCSELFEXE
+ S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
+#else
#ifdef OS2
sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
#else
sv_setpv(GvSV(tmpgv),PL_origargv[0]);
#endif
- if ((PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV))) {
- GvMULTI_on(PL_argvgv);
- (void)gv_AVadd(PL_argvgv);
- av_clear(GvAVn(PL_argvgv));
- for (; argc > 0; argc--,argv++) {
- SV *sv = newSVpv(argv[0],0);
- av_push(GvAVn(PL_argvgv),sv);
- if (PL_widesyscalls)
- (void)sv_utf8_decode(sv);
- }
+#endif
}
if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
HV *hv;
env = environ;
if (env != environ)
environ[0] = Nullch;
-#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
- {
- char **env_base;
- for (env_base = env; *env; env++)
- dup_env_count++;
- if ((dup_env_base = (char **)
- safesysmalloc( sizeof(char *) * (dup_env_count+1) ))) {
- char **dup_env;
- for (env = env_base, dup_env = dup_env_base;
- *env;
- env++, dup_env++) {
- /* With environ one needs to use safesysmalloc(). */
- *dup_env = safesysmalloc(strlen(*env) + 1);
- (void)strcpy(*dup_env, *env);
- }
- *dup_env = Nullch;
- env = dup_env_base;
- } /* else what? */
- }
-#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
if (env)
for (; *env; env++) {
if (!(s = strchr(*env,'=')))
continue;
- *s++ = '\0';
#if defined(MSDOS)
+ *s = '\0';
(void)strupr(*env);
+ *s = '=';
#endif
- sv = newSVpv(s--,0);
+ sv = newSVpv(s+1, 0);
(void)hv_store(hv, *env, s - *env, sv, 0);
- *s = '=';
+ if (env != environ)
+ mg_set(sv);
}
-#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
- if (dup_env_base) {
- char **dup_env;
- for (dup_env = dup_env_base; *dup_env; dup_env++)
- safesysfree(*dup_env);
- safesysfree(dup_env_base);
- }
-#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
#endif /* USE_ENVIRON_ARRAY */
}
TAINT_NOT;
- if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
+ if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
+ SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
+ SvREADONLY_on(GvSV(tmpgv));
+ }
}
STATIC void
https://perl5.git.perl.org / perl5.git / blobdiff