*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
* 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
- * 2013, 2014, 2015, 2016, 2017 by Larry Wall and others
+ * 2013, 2014, 2015, 2016, 2017, 2018 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.
JMPENV_BOOTSTRAP;
STATUS_ALL_SUCCESS;
+ PL_XPosix_ptrs[_CC_ASCII] = _new_invlist_C_array(ASCII_invlist);
+ PL_XPosix_ptrs[_CC_ALPHANUMERIC] = _new_invlist_C_array(XPosixAlnum_invlist);
+ PL_XPosix_ptrs[_CC_ALPHA] = _new_invlist_C_array(XPosixAlpha_invlist);
+ PL_XPosix_ptrs[_CC_BLANK] = _new_invlist_C_array(XPosixBlank_invlist);
+ PL_XPosix_ptrs[_CC_CASED] = _new_invlist_C_array(Cased_invlist);
+ PL_XPosix_ptrs[_CC_CNTRL] = _new_invlist_C_array(XPosixCntrl_invlist);
+ PL_XPosix_ptrs[_CC_DIGIT] = _new_invlist_C_array(XPosixDigit_invlist);
+ PL_XPosix_ptrs[_CC_GRAPH] = _new_invlist_C_array(XPosixGraph_invlist);
+ PL_XPosix_ptrs[_CC_LOWER] = _new_invlist_C_array(XPosixLower_invlist);
+ PL_XPosix_ptrs[_CC_PRINT] = _new_invlist_C_array(XPosixPrint_invlist);
+ PL_XPosix_ptrs[_CC_PUNCT] = _new_invlist_C_array(XPosixPunct_invlist);
+ PL_XPosix_ptrs[_CC_SPACE] = _new_invlist_C_array(XPerlSpace_invlist);
+ PL_XPosix_ptrs[_CC_UPPER] = _new_invlist_C_array(XPosixUpper_invlist);
+ PL_XPosix_ptrs[_CC_VERTSPACE] = _new_invlist_C_array(VertSpace_invlist);
+ PL_XPosix_ptrs[_CC_WORDCHAR] = _new_invlist_C_array(XPosixWord_invlist);
+ PL_XPosix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(XPosixXDigit_invlist);
+ PL_GCB_invlist = _new_invlist_C_array(_Perl_GCB_invlist);
+ PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
+ PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
+ PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
+ PL_Assigned_invlist = _new_invlist_C_array(Assigned_invlist);
+ PL_SCX_invlist = _new_invlist_C_array(_Perl_SCX_invlist);
+
init_i18nl10n(1);
#if defined(LOCAL_PATCH_COUNT)
/* Start with 1 bucket, for DFS. It's unlikely we'll need more. */
HvMAX(PL_registered_mros) = 0;
- PL_XPosix_ptrs[_CC_ASCII] = _new_invlist_C_array(ASCII_invlist);
- PL_XPosix_ptrs[_CC_ALPHANUMERIC] = _new_invlist_C_array(XPosixAlnum_invlist);
- PL_XPosix_ptrs[_CC_ALPHA] = _new_invlist_C_array(XPosixAlpha_invlist);
- PL_XPosix_ptrs[_CC_BLANK] = _new_invlist_C_array(XPosixBlank_invlist);
- PL_XPosix_ptrs[_CC_CASED] = _new_invlist_C_array(Cased_invlist);
- PL_XPosix_ptrs[_CC_CNTRL] = _new_invlist_C_array(XPosixCntrl_invlist);
- PL_XPosix_ptrs[_CC_DIGIT] = _new_invlist_C_array(XPosixDigit_invlist);
- PL_XPosix_ptrs[_CC_GRAPH] = _new_invlist_C_array(XPosixGraph_invlist);
- PL_XPosix_ptrs[_CC_LOWER] = _new_invlist_C_array(XPosixLower_invlist);
- PL_XPosix_ptrs[_CC_PRINT] = _new_invlist_C_array(XPosixPrint_invlist);
- PL_XPosix_ptrs[_CC_PUNCT] = _new_invlist_C_array(XPosixPunct_invlist);
- PL_XPosix_ptrs[_CC_SPACE] = _new_invlist_C_array(XPerlSpace_invlist);
- PL_XPosix_ptrs[_CC_UPPER] = _new_invlist_C_array(XPosixUpper_invlist);
- PL_XPosix_ptrs[_CC_VERTSPACE] = _new_invlist_C_array(VertSpace_invlist);
- PL_XPosix_ptrs[_CC_WORDCHAR] = _new_invlist_C_array(XPosixWord_invlist);
- PL_XPosix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(XPosixXDigit_invlist);
- PL_GCB_invlist = _new_invlist_C_array(_Perl_GCB_invlist);
- PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
- PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
- PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
- PL_Assigned_invlist = _new_invlist_C_array(Assigned_invlist);
#ifdef HAS_POSIX_2008_LOCALE
PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
#endif
if (*stdo && PerlIO_flush(stdo)) {
PerlIO_restore_errno(stdo);
if (errno)
- PerlIO_printf(PerlIO_stderr(), "Unable to flush stdout: %s",
+ PerlIO_printf(PerlIO_stderr(), "Unable to flush stdout: %s\n",
Strerror(errno));
if (!STATUS_UNIX)
STATUS_ALL_FAILURE;
fail gracefully */
int fd[2];
- if(socketpair(AF_UNIX, SOCK_STREAM, 0, fd)) {
+ if(PerlSock_socketpair_cloexec(AF_UNIX, SOCK_STREAM, 0, fd)) {
perror("Debug leaking scalars socketpair failed");
abort();
}
back into Perl_debug_log, as if we never actually closed it
*/
if(got_fd != debug_fd) {
- if (dup2(got_fd, debug_fd) == -1) {
+ if (PerlLIO_dup2_cloexec(got_fd, debug_fd) == -1) {
where = "dup2";
goto abort;
}
PL_langinfo_buf = NULL;
}
+#ifdef USE_POSIX_2008_LOCALE
+# ifdef USE_LOCALE_NUMERIC
+
+ if (PL_underlying_numeric_obj) {
+ /* Make sure we aren't using the locale space we are about to free */
+ uselocale(LC_GLOBAL_LOCALE);
+ freelocale(PL_underlying_numeric_obj);
+ PL_underlying_numeric_obj = (locale_t) NULL;
+ }
+
+# endif
+#endif
+
/* clear character classes */
for (i = 0; i < POSIX_SWASH_COUNT; i++) {
SvREFCNT_dec(PL_utf8_swash_ptrs[i]);
PL_GCB_invlist = NULL;
PL_LB_invlist = NULL;
PL_SB_invlist = NULL;
+ PL_SCX_invlist = NULL;
PL_WB_invlist = NULL;
PL_Assigned_invlist = NULL;
a C program. C<argv[argc]> must be null. These arguments are where
the script to parse is specified, either by naming a script file or by
providing a script in a C<-e> option.
+If L<C<$0>|perlvar/$0> will be written to in the Perl interpreter, then
+the argument strings must be in writable memory, and so mustn't just be
+string constants.
C<env> specifies a set of environment variables that will be used by
this Perl interpreter. If non-null, it must point to a null-terminated
be a suitable value to pass to the C library function C<exit> (or to
return from C<main>), to serve as an exit code indicating the nature
of the way initialisation terminated. However, this isn't portable,
-due to differing exit code conventions. An attempt is made to return
-an exit code of the type required by the host operating system, but
-because it is constrained to be non-zero, it is not necessarily possible
-to indicate every type of exit. It is only reliable on Unix, where a
-zero exit code can be augmented with a set bit that will be ignored.
-In any case, this function is not the correct place to acquire an exit
-code: one should get that from L</perl_destruct>.
+due to differing exit code conventions. A historical bug is preserved
+for the time being: if the Perl built-in C<exit> is called during this
+function's execution, with a type of exit entailing a zero exit code
+under the host operating system's conventions, then this function
+returns zero rather than a non-zero value. This bug, [perl #2754],
+leads to C<perl_run> being called (and therefore C<INIT> blocks and the
+main program running) despite a call to C<exit>. It has been preserved
+because a popular module-installing module has come to rely on it and
+needs time to be fixed. This issue is [perl #132577], and the original
+bug is due to be fixed in Perl 5.30.
=cut
*/
call_list(oldscope, PL_checkav);
}
ret = STATUS_EXIT;
- if (ret == 0) ret = 0x100;
+ if (ret == 0) {
+ /*
+ * At this point we should do
+ * ret = 0x100;
+ * to avoid [perl #2754], but that bugfix has been postponed
+ * because of the Module::Install breakage it causes
+ * [perl #132577].
+ */
+ }
break;
case 3:
PerlIO_printf(Perl_error_log, "panic: top_env\n");
#endif
PerlIO_printf(PIO_stdout,
- "\n\nCopyright 1987-2017, Larry Wall\n");
+ "\n\nCopyright 1987-2018, Larry Wall\n");
#ifdef MSDOS
PerlIO_printf(PIO_stdout,
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
};
const char * const err = "Failed to create a fake bit bucket";
if (strEQ(scriptname, BIT_BUCKET)) {
-#ifdef HAS_MKSTEMP /* Hopefully mkstemp() is safe here. */
- int old_umask = umask(0177);
- int tmpfd = mkstemp(tmpname);
- umask(old_umask);
+ int tmpfd = Perl_my_mkstemp_cloexec(tmpname);
if (tmpfd > -1) {
scriptname = tmpname;
close(tmpfd);
} else
Perl_croak(aTHX_ err);
-#endif
}
#endif
rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
CopFILE(PL_curcop), Strerror(errno));
}
fd = PerlIO_fileno(rsfp);
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
- if (fd >= 0) {
- /* ensure close-on-exec */
- if (fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
- Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
- CopFILE(PL_curcop), Strerror(errno));
- }
- }
-#endif
if (fd < 0 ||
(PerlLIO_fstat(fd, &tmpstatbuf) >= 0
https://perl5.git.perl.org / perl5.git / blobdiff