PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
+ PL_errors = newSVpvn("",0);
ENTER;
}
SvREFCNT(&PL_sv_yes) = 0;
sv_clear(&PL_sv_yes);
SvANY(&PL_sv_yes) = NULL;
- SvREADONLY_off(&PL_sv_yes);
+ SvFLAGS(&PL_sv_yes) = 0;
SvREFCNT(&PL_sv_no) = 0;
sv_clear(&PL_sv_no);
SvANY(&PL_sv_no) = NULL;
- SvREADONLY_off(&PL_sv_no);
+ SvFLAGS(&PL_sv_no) = 0;
SvREFCNT(&PL_sv_undef) = 0;
SvREADONLY_off(&PL_sv_undef);
#if defined(PERL_OBJECT)
PerlMem_free(this);
#else
+# if defined(PERL_IMPLICIT_SYS) && defined(WIN32)
+ void *host = w32_internal_host;
PerlMem_free(aTHXx);
+ win32_delete_internal_host(host);
+# else
+ PerlMem_free(aTHXx);
+# endif
#endif
}
SAVETMPS;
push_return(PL_op->op_next);
- PUSHBLOCK(cx, CXt_EVAL, PL_stack_sp);
+ PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0, 0);
PL_eval_root = PL_op; /* Only needed so that goto works right. */
case '0':
{
dTHR;
+ numlen = 0; /* disallow underscores */
rschar = (U32)scan_oct(s, 4, &numlen);
SvREFCNT_dec(PL_nrs);
if (rschar & ~((U8)~0))
if (isDIGIT(*s)) {
PL_ors = savepv("\n");
PL_orslen = 1;
+ numlen = 0; /* disallow underscores */
*PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
s += numlen;
}
sv_catpv( sv, " ()");
}
} else {
+ if (s == start)
+ Perl_croak(aTHX_ "Module name required with -%c option",
+ s[-1]);
sv_catpvn(sv, start, s-start);
sv_catpv(sv, " split(/,/,q{");
sv_catpv(sv, ++s);
return s;
case 'W':
PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
- PL_compiling.cop_warnings = WARN_ALL ;
+ PL_compiling.cop_warnings = pWARN_ALL ;
s++;
return s;
case 'X':
PL_dowarn = G_WARN_ALL_OFF;
- PL_compiling.cop_warnings = WARN_NONE ;
+ PL_compiling.cop_warnings = pWARN_NONE ;
s++;
return s;
case '*':
CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
+ PL_nullstash = GvHV(gv_fetchpv("<none>::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
sv_setpvn(get_sv("/", TRUE), "\n", 1);
}
* an irrelevant filesystem while trying to reach the right one.
*/
-# ifdef HAS_FSTATVFS
+#undef FD_ON_NOSUID_CHECK_OKAY /* found the syscalls to do the check? */
+
+# if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
+ defined(HAS_FSTATVFS)
+# define FD_ON_NOSUID_CHECK_OKAY
struct statvfs stfs;
+
check_okay = fstatvfs(fd, &stfs) == 0;
on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
-# else
-# ifdef PERL_MOUNT_NOSUID
-# if defined(HAS_FSTATFS) && \
- defined(HAS_STRUCT_STATFS) && \
- defined(HAS_STRUCT_STATFS_F_FLAGS)
+# endif /* fstatvfs */
+
+# if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
+ defined(PERL_MOUNT_NOSUID) && \
+ defined(HAS_FSTATFS) && \
+ defined(HAS_STRUCT_STATFS) && \
+ defined(HAS_STRUCT_STATFS_F_FLAGS)
+# define FD_ON_NOSUID_CHECK_OKAY
struct statfs stfs;
+
check_okay = fstatfs(fd, &stfs) == 0;
on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
-# else
-# if defined(HAS_FSTAT) && \
- defined(HAS_USTAT) && \
- defined(HAS_GETMNT) && \
- defined(HAS_STRUCT_FS_DATA) && \
- defined(NOSTAT_ONE)
+# endif /* fstatfs */
+
+# if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
+ defined(PERL_MOUNT_NOSUID) && \
+ defined(HAS_FSTAT) && \
+ defined(HAS_USTAT) && \
+ defined(HAS_GETMNT) && \
+ defined(HAS_STRUCT_FS_DATA) && \
+ defined(NOSTAT_ONE)
+# define FD_ON_NOSUID_CHECK_OKAY
struct stat fdst;
+
if (fstat(fd, &fdst) == 0) {
- struct ustat us;
- if (ustat(fdst.st_dev, &us) == 0) {
- struct fs_data fsd;
- /* NOSTAT_ONE here because we're not examining fields which
- * vary between that case and STAT_ONE. */
+ struct ustat us;
+ if (ustat(fdst.st_dev, &us) == 0) {
+ struct fs_data fsd;
+ /* NOSTAT_ONE here because we're not examining fields which
+ * vary between that case and STAT_ONE. */
if (getmnt((int*)0, &fsd, (int)0, NOSTAT_ONE, us.f_fname) == 0) {
- size_t cmplen = sizeof(us.f_fname);
- if (sizeof(fsd.fd_req.path) < cmplen)
- cmplen = sizeof(fsd.fd_req.path);
- if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) &&
- fdst.st_dev == fsd.fd_req.dev) {
- check_okay = 1;
- on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
- }
- }
- }
- }
- }
-# endif /* fstat+ustat+getmnt */
-# endif /* fstatfs */
-# else
-# if defined(HAS_GETMNTENT) && \
- defined(HAS_HASMNTOPT) && \
- defined(MNTOPT_NOSUID)
- FILE *mtab = fopen("/etc/mtab", "r");
- struct mntent *entry;
- struct stat stb, fsb;
+ size_t cmplen = sizeof(us.f_fname);
+ if (sizeof(fsd.fd_req.path) < cmplen)
+ cmplen = sizeof(fsd.fd_req.path);
+ if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) &&
+ fdst.st_dev == fsd.fd_req.dev) {
+ check_okay = 1;
+ on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
+ }
+ }
+ }
+ }
+ }
+# endif /* fstat+ustat+getmnt */
+
+# if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
+ defined(HAS_GETMNTENT) && \
+ defined(HAS_HASMNTOPT) && \
+ defined(MNTOPT_NOSUID)
+# define FD_ON_NOSUID_CHECK_OKAY
+ FILE *mtab = fopen("/etc/mtab", "r");
+ struct mntent *entry;
+ struct stat stb, fsb;
if (mtab && (fstat(fd, &stb) == 0)) {
- while (entry = getmntent(mtab)) {
- if (stat(entry->mnt_dir, &fsb) == 0
- && fsb.st_dev == stb.st_dev)
- {
- /* found the filesystem */
- check_okay = 1;
- if (hasmntopt(entry, MNTOPT_NOSUID))
- on_nosuid = 1;
- break;
- } /* A single fs may well fail its stat(). */
- }
+ while (entry = getmntent(mtab)) {
+ if (stat(entry->mnt_dir, &fsb) == 0
+ && fsb.st_dev == stb.st_dev)
+ {
+ /* found the filesystem */
+ check_okay = 1;
+ if (hasmntopt(entry, MNTOPT_NOSUID))
+ on_nosuid = 1;
+ break;
+ } /* A single fs may well fail its stat(). */
+ }
}
if (mtab)
- fclose(mtab);
-# endif /* getmntent+hasmntopt */
-# endif /* PERL_MOUNT_NOSUID: fstatfs or fstat+ustat+statfs */
-# endif /* statvfs */
+ fclose(mtab);
+# endif /* getmntent+hasmntopt */
if (!check_okay)
Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid", PL_origfilename);
incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
#endif
+#ifdef PERL_OTHERLIBDIRS
+ incpush(PERL_OTHERLIBDIRS, TRUE, TRUE);
+#endif
+
if (!PL_tainting)
incpush(".", FALSE, FALSE);
}