+#line 2 "perl.c"
/* perl.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
- * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
+ * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 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.
OP_REFCNT_INIT;
HINTS_REFCNT_INIT;
MUTEX_INIT(&PL_dollarzero_mutex);
-# endif
-#ifdef PERL_IMPLICIT_CONTEXT
MUTEX_INIT(&PL_my_ctx_mutex);
# endif
}
PERL_UNUSED_ARG(my_perl);
#endif
+ assert(PL_scopestack_ix == 1);
+
/* wait for all pseudo-forked children to finish */
PERL_WAIT_FOR_CHILDREN;
}
LEAVE;
FREETMPS;
+ assert(PL_scopestack_ix == 0);
/* Need to flush since END blocks can produce output */
my_fflush_all();
SvREFCNT_dec(PL_isarev);
FREETMPS;
- if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
+ if (destruct_level >= 2) {
if (PL_scopestack_ix != 0)
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
- (long)PL_scopestack_ix);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+ "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
+ (long)PL_scopestack_ix);
if (PL_savestack_ix != 0)
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "Unbalanced saves: %ld more saves than restores\n",
- (long)PL_savestack_ix);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+ "Unbalanced saves: %ld more saves than restores\n",
+ (long)PL_savestack_ix);
if (PL_tmps_floor != -1)
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n",
- (long)PL_tmps_floor + 1);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n",
+ (long)PL_tmps_floor + 1);
if (cxstack_ix != -1)
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n",
- (long)cxstack_ix + 1);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n",
+ (long)cxstack_ix + 1);
}
/* Now absolutely destruct everything, somehow or other, loops or no. */
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x%"UVxf
" refcnt=%"UVuf pTHX__FORMAT "\n"
- "\tallocated at %s:%d %s %s%s\n",
+ "\tallocated at %s:%d %s %s%s; serial %"UVuf"\n",
(void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
pTHX__VALUE,
sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
sv->sv_debug_inpad ? "for" : "by",
sv->sv_debug_optype ?
PL_op_name[sv->sv_debug_optype]: "(none)",
- sv->sv_debug_cloned ? " (cloned)" : ""
+ sv->sv_debug_cloned ? " (cloned)" : "",
+ sv->sv_debug_serial
);
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
Perl_dump_sv_child(aTHX_ sv);
#else
const int local_patch_count = 0;
#endif
- const int entries = 4 + local_patch_count;
+ const int entries = 3 + local_patch_count;
int i;
static char non_bincompat_options[] =
# ifdef DEBUGGING
" DEBUGGING"
# endif
# ifdef NO_MATHOMS
- " NO_MATHOMS"
+ " NO_MATHOMS"
# endif
# ifdef PERL_DISABLE_PMC
" PERL_DISABLE_PMC"
# ifdef PERL_USE_SAFE_PUTENV
" PERL_USE_SAFE_PUTENV"
# endif
-# ifdef USE_SITECUSTOMIZE
- " USE_SITECUSTOMIZE"
-# endif
+# ifdef USE_ATTRIBUTES_FOR_PERLIO
+ " USE_ATTRIBUTES_FOR_PERLIO"
+# endif
# ifdef USE_FAST_STDIO
" USE_FAST_STDIO"
# endif
+# ifdef USE_PERL_ATOF
+ " USE_PERL_ATOF"
+# endif
+# ifdef USE_SITECUSTOMIZE
+ " USE_SITECUSTOMIZE"
+# endif
;
PERL_UNUSED_ARG(cv);
PERL_UNUSED_ARG(items);
PUSHs(&PL_sv_undef);
#endif
- PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(OSNAME), SVs_TEMP));
-
for (i = 1; i <= local_patch_count; i++) {
/* This will be an undef, if PL_localpatches[i] is NULL. */
PUSHs(sv_2mortal(newSVpv(PL_localpatches[i], 0)));
# endif
Sighandler_t sigstate = rsignal_state(SIGCHLD);
if (sigstate == (Sighandler_t) SIG_IGN) {
- if (ckWARN(WARN_SIGNAL))
- Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
- "Can't ignore signal CHLD, forcing to default");
+ Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+ "Can't ignore signal CHLD, forcing to default");
(void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
}
}
PL_curstash = PL_defstash;
FREETMPS;
JMPENV_POP;
- if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
- Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
/* NOTREACHED */
case 3:
PL_curstash = PL_defstash;
FREETMPS;
JMPENV_POP;
- if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
- Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
/* NOTREACHED */
case 3:
}
#endif
PerlIO_printf(PerlIO_stdout(),
- "\nThis is perl, %"SVf
- " built for %s",
- level,
- ARCHNAME);
+ "\nThis is perl " STRINGIFY(PERL_REVISION)
+ ", version " STRINGIFY(PERL_VERSION)
+ ", subversion " STRINGIFY(PERL_SUBVERSION)
+ " (%"SVf") built for " ARCHNAME, level
+ );
SvREFCNT_dec(level);
}
#else /* DGUX */
#endif
PerlIO_printf(PerlIO_stdout(),
- "\n\nCopyright 1987-2009, Larry Wall\n");
+ "\n\nCopyright 1987-2010, Larry Wall\n");
#ifdef MSDOS
PerlIO_printf(PerlIO_stdout(),
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
SET_MARK_OFFSET;
Newx(PL_scopestack,REASONABLE(32),I32);
+#ifdef DEBUGGING
+ Newx(PL_scopestack_name,REASONABLE(32),const char*);
+#endif
PL_scopestack_ix = 0;
PL_scopestack_max = REASONABLE(32);
Safefree(PL_tmps_stack);
Safefree(PL_markstack);
Safefree(PL_scopestack);
+#ifdef DEBUGGING
+ Safefree(PL_scopestack_name);
+#endif
Safefree(PL_savestack);
}
dVAR;
GV *tmpgv;
IO *io;
+ AV *isa;
sv_setpvs(get_sv("\"", GV_ADD), " ");
PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
+
+ /* Historically, PVIOs were blessed into IO::Handle, unless
+ FileHandle was loaded, in which case they were blessed into
+ that. Action at a distance.
+ However, if we simply bless into IO::Handle, we break code
+ that assumes that PVIOs will have (among others) a seek
+ method. IO::File inherits from IO::Handle and IO::Seekable,
+ and provides the needed methods. But if we simply bless into
+ it, then we break code that assumed that by loading
+ IO::Handle, *it* would work.
+ So a compromise is to set up the correct @IO::File::ISA,
+ so that code that does C<use IO::Handle>; will still work.
+ */
+
+ isa = get_av("IO::File::ISA", GV_ADD | GV_ADDMULTI);
+ av_push(isa, newSVpvs("IO::Handle"));
+ av_push(isa, newSVpvs("IO::Seekable"));
+ av_push(isa, newSVpvs("Exporter"));
+ (void) gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVGV);
+ (void) gv_fetchpvs("IO::Seekable::", GV_ADD, SVt_PVGV);
+ (void) gv_fetchpvs("Exporter::", GV_ADD, SVt_PVGV);
+
+
PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stdingv);
io = GvIOp(PL_stdingv);
const char *perl5lib = NULL;
#endif
const char *s;
-#ifdef WIN32
+#if defined(WIN32) && !defined(PERL_IS_MINIPERL)
STRLEN len;
#endif
(and not the architecture specific directories from $ENV{PERL5LIB}) */
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
+ SITEARCH, SITELIB, VENDORARCH, VENDORLIB, ARCHLIB and PRIVLIB
*/
#ifdef APPLLIB_EXP
S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP),
}
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
+ SITELIB and VENDORLIB for older versions
*/
#ifdef APPLLIB_EXP
S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), INCPUSH_ADD_OLD_VERS
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
JMPENV_POP;
- if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
- if (paramList == PL_beginav)
- Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
- else
- Perl_croak(aTHX_ "%s failed--call queue aborted",
- paramList == PL_checkav ? "CHECK"
- : paramList == PL_initav ? "INIT"
- : paramList == PL_unitcheckav ? "UNITCHECK"
- : "END");
- }
my_exit_jump();
/* NOTREACHED */
case 3: