FREETMPS;
/* Need to flush since END blocks can produce output */
- PerlIO_flush((PerlIO*)NULL);
+ my_fflush_all();
if (CALL_FPTR(PL_threadhook)(aTHX)) {
/* Threads hook has vetoed further cleanup */
- return STATUS_NATIVE_EXPORT;;
+ return STATUS_NATIVE_EXPORT;
}
/* We must account for everything. */
/* Destroy the main CV and syntax tree */
if (PL_main_root) {
- PL_curpad = AvARRAY(PL_comppad);
+ /* If running under -d may not have PL_comppad. */
+ PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL;
op_free(PL_main_root);
PL_main_root = Nullop;
}
#endif
/* The exit() function will do everything that needs doing. */
- return STATUS_NATIVE_EXPORT;;
+ return STATUS_NATIVE_EXPORT;
}
/* jettison our possibly duplicated environment */
#ifdef MACOS_TRADITIONAL
/* ignore -e for Dev:Pseudo argument */
if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
- break;
+ break;
#endif
if (PL_euid != PL_uid || PL_egid != PL_gid)
Perl_croak(aTHX_ "No -e allowed in setuid scripts");
if (!PL_do_undump)
init_postdump_symbols(argc,argv,env);
+ /* PL_wantutf8 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)))
forbid_setid("-D");
if (isALPHA(s[1])) {
/* if adding extra options, remember to update DEBUG_MASK */
- static char debopts[] = "psltocPmfrxuLHXDSTRJ";
+ static char debopts[] = "psltocPmfrxuLHXDSTRJvC";
char *d;
for (s++; *s && (d = strchr(debopts,*s)); s++)
}
case 'h':
usage(PL_origargv[0]);
- PerlProc_exit(0);
+ my_exit(0);
case 'i':
if (PL_inplace)
Safefree(PL_inplace);
Complete documentation for Perl, including FAQ lists, should be found on\n\
this system using `man perl' or `perldoc perl'. If you have access to the\n\
Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
- PerlProc_exit(0);
+ my_exit(0);
case 'w':
if (! (PL_dowarn & G_WARN_ALL_MASK))
PL_dowarn |= G_WARN_ON;
S_find_beginning(pTHX)
{
register char *s, *s2;
+#ifdef MACOS_TRADITIONAL
+ int maclines = 0;
+#endif
/* skip forward in input to the real script? */
if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
if (!gMacPerl_AlwaysExtract)
Perl_croak(aTHX_ "No Perl script found in input\n");
-
+
if (PL_doextract) /* require explicit override ? */
if (!OverrideExtract(PL_origfilename))
Perl_croak(aTHX_ "User aborted script\n");
else
PL_doextract = FALSE;
-
+
/* Pater peccavi, file does not have #! */
PerlIO_rewind(PL_rsfp);
-
+
break;
}
#else
;
}
#ifdef MACOS_TRADITIONAL
+ /* We are always searching for the #!perl line in MacPerl,
+ * so if we find it, still keep the line count correct
+ * by counting lines we already skipped over
+ */
+ for (; maclines > 0 ; maclines--)
+ PerlIO_ungetc(PL_rsfp, '\n');
+
break;
+
+ /* gMacPerl_AlwaysExtract is false in MPW tool */
+ } else if (gMacPerl_AlwaysExtract) {
+ ++maclines;
#endif
}
}
{
char buf[MAXPATHLEN];
int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+
+ /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
+ includes a spurious NUL which will cause $^X to fail in system
+ or backticks (this will prevent extensions from being built and
+ many tests from working). readlink is not meant to add a NUL.
+ Normal readlink works fine.
+ */
+ if (len > 0 && buf[len-1] == '\0') {
+ len--;
+ }
+
/* FreeBSD's implementation is acknowledged to be imperfect, sometimes
returning the text "unknown" from the readlink rather than the path
to the executable (or returning an error from the readlink). Any valid