PERL_SET_INTERP(my_perl); \
INIT_THREADS; \
ALLOC_THREAD_KEY; \
+ PERL_SET_THX(my_perl); \
+ OP_REFCNT_INIT; \
+ } \
+ else { \
+ PERL_SET_THX(my_perl); \
} \
- PERL_SET_THX(my_perl); \
} STMT_END
# else
# define INIT_TLS_AND_INTERP \
PL_localpatches = local_patches; /* For possible -v */
#endif
+#ifdef HAVE_INTERP_INTERN
+ sys_intern_init();
+#endif
+
PerlIO_init(); /* Hook to IO system */
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
+ PL_errors = newSVpvn("",0);
ENTER;
}
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = Nullsv;
+#ifndef USE_ITHREADS
+ SvREFCNT_dec(CopFILEGV(&PL_compiling));
+ CopFILEGV_set(&PL_compiling, Nullgv);
+#endif
/* Prepare to destruct main symbol table. */
SvREFCNT(&PL_sv_yes) = 0;
sv_clear(&PL_sv_yes);
SvANY(&PL_sv_yes) = NULL;
+ SvFLAGS(&PL_sv_yes) = 0;
SvREFCNT(&PL_sv_no) = 0;
sv_clear(&PL_sv_no);
SvANY(&PL_sv_no) = NULL;
+ SvFLAGS(&PL_sv_no) = 0;
+
+ SvREFCNT(&PL_sv_undef) = 0;
+ SvREADONLY_off(&PL_sv_undef);
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
#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
}
char *p;
STRLEN len = strlen(s);
p = savepvn(s, len);
- incpush(p, TRUE);
+ incpush(p, TRUE, TRUE);
sv_catpvn(sv, "-I", 2);
sv_catpvn(sv, p, len);
sv_catpvn(sv, " ", 1);
/* name of the subroutine */
/* See G_* flags in cop.h */
{
- dSP;
- OP myop;
- if (!PL_op) {
- Zero(&myop, 1, OP);
- PL_op = &myop;
- }
- XPUSHs(sv_2mortal(newSVpv(methname,0)));
- PUTBACK;
- pp_method();
- if (PL_op == &myop)
- PL_op = Nullop;
- return call_sv(*PL_stack_sp--, flags);
+ return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
}
/* May be called with any of a CV, a GV, or an SV containing the name. */
{
dSP;
LOGOP myop; /* fake syntax tree node */
+ UNOP method_op;
I32 oldmark;
I32 retval;
I32 oldscope;
&& !(flags & G_NODEBUG))
PL_op->op_private |= OPpENTERSUB_DB;
+ if (flags & G_METHOD) {
+ Zero(&method_op, 1, UNOP);
+ method_op.op_next = PL_op;
+ method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
+ myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+ PL_op = &method_op;
+ }
+
if (!(flags & G_EVAL)) {
CATCH_SET(TRUE);
call_body((OP*)&myop, FALSE);
ENTER;
SAVETMPS;
- push_return(PL_op->op_next);
- PUSHBLOCK(cx, CXt_EVAL, PL_stack_sp);
+ push_return(Nullop);
+ 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. */
"-0[octal] specify record separator (\\0, if no argument)",
"-a autosplit mode with -n or -p (splits $_ into @F)",
"-C enable native wide character system interfaces",
-"-c check syntax only (runs BEGIN and END blocks)",
+"-c check syntax only (runs BEGIN and CHECK blocks)",
"-d[:debugger] run program under debugger",
"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
"-e 'command' one line of program (several -e's allowed, omit programfile)",
};
char **p = usage_msg;
- printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
+ PerlIO_printf(PerlIO_stdout(),
+ "\nUsage: %s [switches] [--] [programfile] [arguments]",
+ name);
while (*p)
- printf("\n %s", *p++);
+ PerlIO_printf(PerlIO_stdout(), "\n %s", *p++);
}
/* This routine handles any switches that can be given during run */
case '0':
{
dTHR;
+ numlen = 0; /* disallow underscores */
rschar = (U32)scan_oct(s, 4, &numlen);
SvREFCNT_dec(PL_nrs);
if (rschar & ~((U8)~0))
p++;
} while (*p && *p != '-');
e = savepvn(s, e-s);
- incpush(e, TRUE);
+ incpush(e, TRUE, TRUE);
Safefree(e);
s = p;
if (*s == '-')
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);
s++;
return s;
case 'v':
- printf(Perl_form(aTHX_ "\nThis is perl, v%vd built for %s",
- PL_patchlevel, ARCHNAME));
+ PerlIO_printf(PerlIO_stdout(),
+ Perl_form(aTHX_ "\nThis is perl, v%vd built for %s",
+ PL_patchlevel, ARCHNAME));
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
- printf("\n(with %d registered patch%s, see perl -V for more detail)",
- (int)LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
+ PerlIO_printf(PerlIO_stdout(),
+ "\n(with %d registered patch%s, "
+ "see perl -V for more detail)",
+ (int)LOCAL_PATCH_COUNT,
+ (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
- printf("\n\nCopyright 1987-2000, Larry Wall\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "\n\nCopyright 1987-2000, Larry Wall\n");
#ifdef MSDOS
- printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
#ifdef DJGPP
- printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
- printf("djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n"
+ "djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1999\n");
#endif
#ifdef OS2
- printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
- "Version 5 port Copyright (c) 1994-1999, Andreas Kaiser, Ilya Zakharevich\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
+ "Version 5 port Copyright (c) 1994-1999, Andreas Kaiser, Ilya Zakharevich\n");
#endif
#ifdef atarist
- printf("atariST series port, ++jrb bammi@cadence.com\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "atariST series port, ++jrb bammi@cadence.com\n");
#endif
#ifdef __BEOS__
- printf("BeOS port Copyright Tom Spindler, 1997-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "BeOS port Copyright Tom Spindler, 1997-1999\n");
#endif
#ifdef MPE
- printf("MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1999\n");
#endif
#ifdef OEMVS
- printf("MVS (OS390) port by Mortice Kern Systems, 1997-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "MVS (OS390) port by Mortice Kern Systems, 1997-1999\n");
#endif
#ifdef __VOS__
- printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
#endif
#ifdef __OPEN_VM
- printf("VM/ESA port by Neale Ferguson, 1998-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "VM/ESA port by Neale Ferguson, 1998-1999\n");
#endif
#ifdef POSIX_BC
- printf("BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
#endif
#ifdef __MINT__
- printf("MiNT port by Guido Flohr, 1997-1999\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "MiNT port by Guido Flohr, 1997-1999\n");
#endif
#ifdef EPOC
- printf("EPOC port by Olaf Flebbe, 1999-2000\n");
+ PerlIO_printf(PerlIO_stdout(),
+ "EPOC port by Olaf Flebbe, 1999-2000\n");
#endif
#ifdef BINARY_BUILD_NOTICE
BINARY_BUILD_NOTICE;
#endif
- printf("\n\
+ PerlIO_printf(PerlIO_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.0 source kit.\n\n\
Complete documentation for Perl, including FAQ lists, should be found on\n\
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);
}
sv_catpvn(sv, "-I", 2);
sv_catpv(sv,PRIVLIB_EXP);
-#ifdef MSDOS
+#if defined(MSDOS) || defined(WIN32)
Perl_sv_setpvf(aTHX_ cmd, "\
sed %s -e \"/^[^#]/b\" \
-e \"/^#[ ]*include[ ]/b\" \
* 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);
SV *sv = newSVpv(argv[0],0);
av_push(GvAVn(PL_argvgv),sv);
if (PL_widesyscalls)
- sv_utf8_upgrade(sv);
+ (void)sv_utf8_decode(sv);
}
}
if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
if (s)
- incpush(s, TRUE);
+ incpush(s, TRUE, TRUE);
else
- incpush(PerlEnv_getenv("PERLLIB"), FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
* "natural" VMS idiom for a Unix path string. We allow each
char buf[256];
int idx = 0;
if (my_trnlnm("PERL5LIB",buf,0))
- do { incpush(buf,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+ do { incpush(buf,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
else
- while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE);
+ while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE);
#endif /* VMS */
}
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH and SITELIB
+ ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, TRUE);
+ incpush(APPLLIB_EXP, TRUE, TRUE);
#endif
#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE);
+ incpush(ARCHLIB_EXP, FALSE, FALSE);
#endif
#ifndef PRIVLIB_EXP
-#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
+# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE);
+ incpush(PRIVLIB_EXP, TRUE, FALSE);
#else
- incpush(PRIVLIB_EXP, FALSE);
+ incpush(PRIVLIB_EXP, FALSE, FALSE);
+#endif
+
+#ifdef SITEARCH_EXP
+ /* sitearch is always relative to sitelib on Windows for
+ * DLL-based path intuition to work correctly */
+# if !defined(WIN32)
+ incpush(SITEARCH_EXP, FALSE, FALSE);
+# endif
#endif
-#if defined(WIN32)
- incpush(SITELIB_EXP, TRUE); /* XXX Win32 needs inc_version_list support */
-#else
#ifdef SITELIB_EXP
- {
- char *path = SITELIB_EXP;
-
- if (path) {
- char buf[1024];
- char *ver = strrchr(path,'/'); /* XXX Hack, Configure var needed */
- if (ver && ver[1] == (STRINGIFY(PERL_REVISION))[0]
- && strlen(path) < sizeof(buf))
- {
- strcpy(buf,path);
- buf[ver-path] = '\0';
- path = buf;
- }
- incpush(path, TRUE);
- }
- }
+# if defined(WIN32)
+ incpush(SITELIB_EXP, TRUE, FALSE); /* this picks up sitearch as well */
+# else
+ incpush(SITELIB_EXP, FALSE, FALSE);
+# endif
#endif
+
+#ifdef SITELIB_STEM /* Search for version-specific dirs below here */
+ incpush(SITELIB_STEM, FALSE, TRUE);
#endif
-#if defined(PERL_VENDORLIB_EXP)
-#if defined(WIN32)
- incpush(PERL_VENDORLIB_EXP, TRUE);
-#else
- incpush(PERL_VENDORLIB_EXP, FALSE);
+
+#ifdef PERL_VENDORARCH_EXP
+ /* vendorarch is always relative to vendorlib on Windows for
+ * DLL-based path intuition to work correctly */
+# if !defined(WIN32)
+ incpush(PERL_VENDORARCH_EXP, FALSE, FALSE);
+# endif
+#endif
+
+#ifdef PERL_VENDORLIB_EXP
+# if defined(WIN32)
+ incpush(PERL_VENDORLIB_EXP, TRUE, FALSE); /* this picks up vendorarch as well */
+# else
+ incpush(PERL_VENDORLIB_EXP, FALSE, FALSE);
+# endif
+#endif
+
+#ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
+ incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
#endif
+
+#ifdef PERL_OTHERLIBDIRS
+ incpush(PERL_OTHERLIBDIRS, TRUE, TRUE);
#endif
+
if (!PL_tainting)
- incpush(".", FALSE);
+ incpush(".", FALSE, FALSE);
}
#if defined(DOSISH)
#endif
STATIC void
-S_incpush(pTHX_ char *p, int addsubdirs)
+S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
{
SV *subdir = Nullsv;
- if (!p)
+ if (!p || !*p)
return;
- if (addsubdirs) {
+ if (addsubdirs || addoldvers) {
subdir = sv_newmortal();
}
* BEFORE pushing libdir onto @INC we may first push version- and
* archname-specific sub-directories.
*/
- if (addsubdirs) {
+ if (addsubdirs || addoldvers) {
#ifdef PERL_INC_VERSION_LIST
/* Configure terminates PERL_INC_VERSION_LIST with a NULL */
const char *incverlist[] = { PERL_INC_VERSION_LIST };
"Failed to unixify @INC element \"%s\"\n",
SvPV(libdir,len));
#endif
- /* .../version/archname if -d .../version/archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", libdir,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
- /* .../version if -d .../version */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
- /* .../archname if -d .../archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ if (addsubdirs) {
+ /* .../version/archname if -d .../version/archname */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s",
+ libdir,
+ (int)PERL_REVISION, (int)PERL_VERSION,
+ (int)PERL_SUBVERSION, ARCHNAME);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
-#ifdef PERL_INC_VERSION_LIST
- for (incver = incverlist; *incver; incver++) {
- /* .../xxx if -d .../xxx */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+ /* .../version if -d .../version */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
+ (int)PERL_REVISION, (int)PERL_VERSION,
+ (int)PERL_SUBVERSION);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
+ /* .../archname if -d .../archname */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ }
+
+#ifdef PERL_INC_VERSION_LIST
+ if (addoldvers) {
+ for (incver = incverlist; *incver; incver++) {
+ /* .../xxx if -d .../xxx */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ }
}
#endif
}
projects / p5sagit/p5-mst-13.2.git / blobdiff