/* perl.c
*
- * Copyright (c) 1987-2002 Larry Wall
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
ALLOC_THREAD_KEY; \
PERL_SET_THX(my_perl); \
OP_REFCNT_INIT; \
+ MUTEX_INIT(&PL_dollarzero_mutex); \
} \
else { \
PERL_SET_THX(my_perl); \
if (PL_perl_destruct_level > 0)
init_interp();
#endif
-
/* Init the real globals (and main thread)? */
if (!PL_linestr) {
-#ifdef USE_ITHREADS
- MUTEX_INIT(&PL_dollarzero_mutex); /* for $0 modifying */
-#endif
#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
#endif
*s = '\0';
SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
SvPOK_on(PL_patchlevel);
- SvNVX(PL_patchlevel) = (NV)PERL_REVISION
- + ((NV)PERL_VERSION / (NV)1000)
-#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- + ((NV)PERL_SUBVERSION / (NV)1000000)
-#endif
- ;
+ SvNVX(PL_patchlevel) = (NV)PERL_REVISION +
+ ((NV)PERL_VERSION / (NV)1000) +
+ ((NV)PERL_SUBVERSION / (NV)1000000);
SvNOK_on(PL_patchlevel); /* dual valued */
SvUTF8_on(PL_patchlevel);
SvREADONLY_on(PL_patchlevel);
#endif
PL_clocktick = HZ;
+ PL_stashcache = newHV();
+
ENTER;
}
Safefree(PL_exitlist);
+ PL_exitlist = NULL;
+ PL_exitlistlen = 0;
+
if (destruct_level == 0){
DEBUG_P(debprofdump());
PL_regex_pad = NULL;
#endif
+ SvREFCNT_dec((SV*) PL_stashcache);
+ PL_stashcache = NULL;
+
/* loosen bonds of global variables */
if(PL_rsfp) {
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
Safefree(PL_reg_poscache);
- Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
+ free_tied_hv_pool();
Safefree(PL_op_mask);
Safefree(PL_psig_ptr);
Safefree(PL_psig_name);
#endif
#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 assumedly 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. */
+ if (!PL_hash_seed_set)
+ PL_hash_seed = get_hash_seed();
+ {
+ char *s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
+
+ if (s) {
+ int i = atoi(s);
+
+ if (i == 1)
+ PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n",
+ PL_hash_seed);
+ }
+ }
+#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
+
PL_origargc = argc;
PL_origargv = argv;
+ {
+ /* Set PL_origalen be the sum of the contiguous argv[]
+ * elements plus the size of the env in case that it is
+ * contiguous with the argv[]. This is used in mg.c:mg_set()
+ * as the maximum modifiable length of $0. In the worst case
+ * the area we are able to modify is limited to the size of
+ * the original argv[0]. (See below for 'contiguous', though.)
+ * --jhi */
+ char *s;
+ int i;
+ UV mask =
+ ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
+ /* Do the mask check only if the args seem like aligned. */
+ UV aligned =
+ (mask < ~(UV)0) && ((PTR2UV(argv[0]) & mask) == PTR2UV(argv[0]));
+
+ /* See if all the arguments are contiguous in memory. Note
+ * that 'contiguous' is a loose term because some platforms
+ * align the argv[] and the envp[]. If the arguments look
+ * like non-aligned, assume that they are 'strictly' or
+ * 'traditionally' contiguous. If the arguments look like
+ * aligned, we just check that they are within aligned
+ * PTRSIZE bytes. As long as no system has something bizarre
+ * like the argv[] interleaved with some other data, we are
+ * fine. (Did I just evoke Murphy's Law?) --jhi */
+ s = PL_origargv[0];
+ while (*s) s++;
+ for (i = 1; i < PL_origargc; i++) {
+ if ((PL_origargv[i] == s + 1
+#ifdef OS2
+ || PL_origargv[i] == s + 2
+#endif
+ )
+ ||
+ (aligned &&
+ (PL_origargv[i] > s &&
+ PL_origargv[i] <=
+ INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
+ )
+ {
+ s = PL_origargv[i];
+ while (*s) s++;
+ }
+ else
+ break;
+ }
+ /* Can we grab env area too to be used as the area for $0? */
+ if (PL_origenviron) {
+ if ((PL_origenviron[0] == s + 1
+#ifdef OS2
+ || (PL_origenviron[0] == s + 9 && (s += 8))
+#endif
+ )
+ ||
+ (aligned &&
+ (PL_origenviron[0] > s &&
+ PL_origenviron[0] <=
+ INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
+ )
+ {
+#ifndef OS2
+ s = PL_origenviron[0];
+ while (*s) s++;
+#endif
+ my_setenv("NoNe SuCh", Nullch);
+ /* Force copy of environment. */
+ for (i = 1; PL_origenviron[i]; i++) {
+ if (PL_origenviron[i] == s + 1
+ ||
+ (aligned &&
+ (PL_origenviron[i] > s &&
+ PL_origenviron[i] <=
+ INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
+ )
+ {
+ s = PL_origenviron[i];
+ while (*s) s++;
+ }
+ else
+ break;
+ }
+ }
+ }
+ PL_origalen = s - PL_origargv[0];
+ }
+
if (PL_do_undump) {
/* Come here if running an undumped a.out. */
reswitch:
switch (*s) {
case 'C':
-#ifdef WIN32
- win32_argv2utf8(argc-1, argv+1);
- /* FALL THROUGH */
-#endif
#ifndef PERL_STRICT_CR
case '\r':
#endif
case 'W':
case 'X':
case 'w':
+ case 'A':
if ((s = moreswitches(s)))
goto reswitch;
break;
case 't':
+ CHECK_MALLOC_TOO_LATE_FOR('t');
if( !PL_tainting ) {
PL_taint_warn = TRUE;
PL_tainting = TRUE;
s++;
goto reswitch;
case 'T':
+ CHECK_MALLOC_TOO_LATE_FOR('T');
PL_tainting = TRUE;
PL_taint_warn = FALSE;
s++;
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T') {
+ CHECK_MALLOC_TOO_LATE_FOR('T');
PL_tainting = TRUE;
PL_taint_warn = FALSE;
}
d = s;
if (!*s)
break;
- if (!strchr("DIMUdmtw", *s))
+ if (!strchr("DIMUdmtwA", *s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
while (++s && *s) {
if (isSPACE(*s)) {
if (!PL_do_undump)
init_postdump_symbols(argc,argv,env);
- /* PL_wantutf8 is conditionally turned on by
+ /* PL_unicode is turned on by -C or by $ENV{PERL_UNICODE}.
+ * PL_utf8locale is conditionally turned on by
* locale.c:Perl_init_i18nl10n() if the environment
* look like the user wants to use UTF-8. */
- if (PL_wantutf8) { /* Requires init_predump_symbols(). */
- IO* io;
- PerlIO* fp;
- SV* sv;
- /* Turn on UTF-8-ness on STDIN, STDOUT, STDERR
- * _and_ the default open discipline. */
- if (PL_stdingv && (io = GvIO(PL_stdingv)) && (fp = IoIFP(io)))
- PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
- if (PL_defoutgv && (io = GvIO(PL_defoutgv)) && (fp = IoOFP(io)))
- PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
- if (PL_stderrgv && (io = GvIO(PL_stderrgv)) && (fp = IoOFP(io)))
- PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
- if ((sv = GvSV(gv_fetchpv("\017PEN", TRUE, SVt_PV)))) {
- sv_setpvn(sv, ":utf8\0:utf8", 11);
- SvSETMAGIC(sv);
+ if (PL_unicode) {
+ /* Requires init_predump_symbols(). */
+ if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
+ IO* io;
+ PerlIO* fp;
+ SV* sv;
+
+ /* Turn on UTF-8-ness on STDIN, STDOUT, STDERR
+ * and the default open disciplines. */
+ if ((PL_unicode & PERL_UNICODE_STDIN_FLAG) &&
+ PL_stdingv && (io = GvIO(PL_stdingv)) &&
+ (fp = IoIFP(io)))
+ PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
+ if ((PL_unicode & PERL_UNICODE_STDOUT_FLAG) &&
+ PL_defoutgv && (io = GvIO(PL_defoutgv)) &&
+ (fp = IoOFP(io)))
+ PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
+ if ((PL_unicode & PERL_UNICODE_STDERR_FLAG) &&
+ PL_stderrgv && (io = GvIO(PL_stderrgv)) &&
+ (fp = IoOFP(io)))
+ PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
+ if ((PL_unicode & PERL_UNICODE_INOUT_FLAG) &&
+ (sv = GvSV(gv_fetchpv("\017PEN", TRUE, SVt_PV)))) {
+ U32 in = PL_unicode & PERL_UNICODE_IN_FLAG;
+ U32 out = PL_unicode & PERL_UNICODE_OUT_FLAG;
+ if (in) {
+ if (out)
+ sv_setpvn(sv, ":utf8\0:utf8", 11);
+ else
+ sv_setpvn(sv, ":utf8\0", 6);
+ }
+ else if (out)
+ sv_setpvn(sv, "\0:utf8", 6);
+ SvSETMAGIC(sv);
+ }
}
}
+ if ((s = PerlEnv_getenv("PERL_SIGNALS"))) {
+ if (strEQ(s, "unsafe"))
+ PL_signals |= PERL_SIGNALS_UNSAFE_FLAG;
+ else if (strEQ(s, "safe"))
+ PL_signals &= ~PERL_SIGNALS_UNSAFE_FLAG;
+ else
+ Perl_croak(aTHX_ "PERL_SIGNALS illegal: \"%s\"", s);
+ }
+
init_lexer();
/* now parse the script */
Tells Perl to C<require> the file named by the string argument. It is
analogous to the Perl code C<eval "require '$file'">. It's even
-implemented that way; consider using Perl_load_module instead.
+implemented that way; consider using load_module instead.
=cut */
PerlIO_printf(PerlIO_stdout(), "\n %s", *p++);
}
+/* convert a string of -D options (or digits) into an int.
+ * sets *s to point to the char after the options */
+
+#ifdef DEBUGGING
+int
+Perl_get_debug_opts(pTHX_ char **s)
+{
+ int i = 0;
+ if (isALPHA(**s)) {
+ /* if adding extra options, remember to update DEBUG_MASK */
+ static char debopts[] = "psltocPmfrxu HXDSTRJvC";
+
+ for (; isALNUM(**s); (*s)++) {
+ char *d = strchr(debopts,**s);
+ if (d)
+ i |= 1 << (d - debopts);
+ else if (ckWARN_d(WARN_DEBUGGING))
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+ "invalid option -D%c\n", **s);
+ }
+ }
+ else {
+ i = atoi(*s);
+ for (; isALNUM(**s); (*s)++) ;
+ }
+# ifdef EBCDIC
+ if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+ "-Dp not implemented on this platform\n");
+# endif
+ return i;
+}
+#endif
+
/* This routine handles any switches that can be given during run */
char *
Perl_moreswitches(pTHX_ char *s)
{
STRLEN numlen;
- U32 rschar;
+ UV rschar;
switch (*s) {
case '0':
{
- I32 flags = 0;
- numlen = 4;
- rschar = (U32)grok_oct(s, &numlen, &flags, NULL);
- SvREFCNT_dec(PL_rs);
- if (rschar & ~((U8)~0))
- PL_rs = &PL_sv_undef;
- else if (!rschar && numlen >= 2)
- PL_rs = newSVpvn("", 0);
- else {
- char ch = (char)rschar;
- PL_rs = newSVpvn(&ch, 1);
- }
- return s + numlen;
+ I32 flags = 0;
+
+ SvREFCNT_dec(PL_rs);
+ if (s[1] == 'x' && s[2]) {
+ char *e;
+ U8 *tmps;
+
+ for (s += 2, e = s; *e; e++);
+ numlen = e - s;
+ flags = PERL_SCAN_SILENT_ILLDIGIT;
+ rschar = (U32)grok_hex(s, &numlen, &flags, NULL);
+ if (s + numlen < e) {
+ rschar = 0; /* Grandfather -0xFOO as -0 -xFOO. */
+ numlen = 0;
+ s--;
+ }
+ PL_rs = newSVpvn("", 0);
+ SvGROW(PL_rs, (STRLEN)(UNISKIP(rschar) + 1));
+ tmps = (U8*)SvPVX(PL_rs);
+ uvchr_to_utf8(tmps, rschar);
+ SvCUR_set(PL_rs, UNISKIP(rschar));
+ SvUTF8_on(PL_rs);
+ }
+ else {
+ numlen = 4;
+ rschar = (U32)grok_oct(s, &numlen, &flags, NULL);
+ if (rschar & ~((U8)~0))
+ PL_rs = &PL_sv_undef;
+ else if (!rschar && numlen >= 2)
+ PL_rs = newSVpvn("", 0);
+ else {
+ char ch = (char)rschar;
+ PL_rs = newSVpvn(&ch, 1);
+ }
+ }
+ return s + numlen;
}
case 'C':
- PL_widesyscalls = TRUE;
- s++;
+ s++;
+ PL_unicode = parse_unicode_opts(&s);
return s;
case 'F':
PL_minus_F = TRUE;
{
#ifdef DEBUGGING
forbid_setid("-D");
- if (isALPHA(s[1])) {
- /* if adding extra options, remember to update DEBUG_MASK */
- static char debopts[] = "psltocPmfrxu HXDSTRJvC";
- char *d;
-
- for (s++; *s && (d = strchr(debopts,*s)); s++)
- PL_debug |= 1 << (d - debopts);
- }
- else {
- PL_debug = atoi(s+1);
- for (s++; isDIGIT(*s); s++) ;
- }
-#ifdef EBCDIC
- if (DEBUG_p_TEST_ && ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
- "-Dp not implemented on this platform\n");
-#endif
- PL_debug |= DEBUG_TOP_FLAG;
+ s++;
+ PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
}
}
return s;
+ case 'A':
+ forbid_setid("-A");
+ if (!PL_preambleav)
+ PL_preambleav = newAV();
+ if (*++s) {
+ SV *sv = newSVpvn("use assertions::activate split(/,/,q{",37);
+ sv_catpv(sv,s);
+ sv_catpv(sv,"})");
+ s+=strlen(s);
+ av_push(PL_preambleav, sv);
+ }
+ else
+ av_push(PL_preambleav, newSVpvn("use assertions::activate",24));
+ return s;
case 'M':
forbid_setid("-M"); /* XXX ? */
/* FALL THROUGH */
return s;
case 't':
if (!PL_tainting)
- Perl_croak(aTHX_ "Too late for \"-t\" option");
+ TOO_LATE_FOR('t');
s++;
return s;
case 'T':
if (!PL_tainting)
- Perl_croak(aTHX_ "Too late for \"-T\" option");
+ TOO_LATE_FOR('T');
s++;
return s;
case 'u':
#endif
PerlIO_printf(PerlIO_stdout(),
- "\n\nCopyright 1987-2002, Larry Wall\n");
+ "\n\nCopyright 1987-2003, Larry Wall\n");
#ifdef MACOS_TRADITIONAL
PerlIO_printf(PerlIO_stdout(),
"\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
#endif
#ifdef MPE
PerlIO_printf(PerlIO_stdout(),
- "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2002\n");
+ "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2003\n");
#endif
#ifdef OEMVS
PerlIO_printf(PerlIO_stdout(),
"EPOC port by Olaf Flebbe, 1999-2002\n");
#endif
#ifdef UNDER_CE
- printf("WINCE port by Rainer Keuchel, 2001-2002\n");
- printf("Built on " __DATE__ " " __TIME__ "\n\n");
+ PerlIO_printf(PerlIO_stdout(),"WINCE port by Rainer Keuchel, 2001-2002\n");
+ PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
wce_hitreturn();
#endif
#ifdef BINARY_BUILD_NOTICE
PL_statbuf.st_mode & (S_ISUID|S_ISGID))
{
/* try again */
+ PERL_FPU_PRE_EXEC
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_FPU_POST_EXEC
Perl_croak(aTHX_ "Can't do setuid\n");
}
# endif
(void)PerlIO_close(PL_rsfp);
#ifndef IAMSUID
/* try again */
+ PERL_FPU_PRE_EXEC
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_FPU_POST_EXEC
#endif
Perl_croak(aTHX_ "Can't do setuid\n");
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
+ PERL_FPU_PRE_EXEC
PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
(int)PERL_REVISION, (int)PERL_VERSION,
(int)PERL_SUBVERSION), PL_origargv);/* try again */
+ PERL_FPU_POST_EXEC
Perl_croak(aTHX_ "Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
PL_uid |= PL_gid << 16;
PL_euid |= PL_egid << 16;
#endif
+ /* 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));
}
+/* This is used very early in the lifetime of the program,
+ * before even the options are parsed, so PL_tainting has
+ * not been initialized properly. */
+bool
+Perl_doing_taint(int argc, char *argv[], char *envp[])
+{
+#ifndef PERL_IMPLICIT_SYS
+ /* If we have PERL_IMPLICIT_SYS we can't call getuid() et alia
+ * before we have an interpreter-- and the whole point of this
+ * function is to be called at such an early stage. If you are on
+ * a system with PERL_IMPLICIT_SYS but you do have a concept of
+ * "tainted because running with altered effective ids', you'll
+ * have to add your own checks somewhere in here. The two most
+ * known samples of 'implicitness' are Win32 and NetWare, neither
+ * of which has much of concept of 'uids'. */
+ int uid = PerlProc_getuid();
+ int euid = PerlProc_geteuid();
+ int gid = PerlProc_getgid();
+ int egid = PerlProc_getegid();
+
+#ifdef VMS
+ uid |= gid << 16;
+ euid |= egid << 16;
+#endif
+ if (uid && (euid != uid || egid != gid))
+ return 1;
+#endif /* !PERL_IMPLICIT_SYS */
+ /* This is a really primitive check; environment gets ignored only
+ * if -T are the first chars together; otherwise one gets
+ * "Too late" message. */
+ if ( argc > 1 && argv[1][0] == '-'
+ && (argv[1][1] == 't' || argv[1][1] == 'T') )
+ return 1;
+ return 0;
+}
+
STATIC void
S_forbid_setid(pTHX_ char *s)
{
HV *ostash = PL_curstash;
PL_curstash = PL_debstash;
- PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
+ PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("DB::args", GV_ADDMULTI, SVt_PVAV))));
AvREAL_off(PL_dbargs);
- PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
- PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
- PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+ PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
+ PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
+ PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
sv_upgrade(GvSV(PL_DBsub), SVt_IV); /* IVX accessed if PERLDB_SUB_NN */
- PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
+ PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsingle, 0);
- PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
+ PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBtrace, 0);
- PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
+ PL_DBsignal = GvSV((gv_fetchpv("DB::signal", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsignal, 0);
+ PL_DBassertion = GvSV((gv_fetchpv("assertion", GV_ADDMULTI, SVt_PV)));
+ sv_setiv(PL_DBassertion, 0);
PL_curstash = ostash;
}
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);
+ if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
+ if (PL_unicode & PERL_UNICODE_ARGV_FLAG)
+ SvUTF8_on(sv);
+ }
+ if (PL_unicode & PERL_UNICODE_WIDESYSCALLS_FLAG) /* Sarathy? */
+ (void)sv_utf8_decode(sv);
}
}
}
atsv = ERRSV;
(void)SvPV(atsv, len);
if (len) {
- STRLEN n_a;
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
if (paramList == PL_beginav)
while (PL_scopestack_ix > oldscope)
LEAVE;
JMPENV_POP;
- Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
+ Perl_croak(aTHX_ "%"SVf"", atsv);
}
break;
case 1:
https://perl5.git.perl.org / perl5.git / blobdiff