}
}
-
void
mg_magical(SV *sv)
{
sv_setpv(sv, os2error(Perl_rc));
}
#else
+#ifdef WIN32
+ {
+ DWORD dwErr = GetLastError();
+ sv_setnv(sv, (double)dwErr);
+ if (dwErr)
+ win32_str_os_error(sv, dwErr);
+ else
+ sv_setpv(sv, "");
+ SetLastError(dwErr);
+ }
+#else
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
#endif
#endif
+#endif
SvNOK_on(sv); /* what a wonderful hack! */
break;
case '\006': /* ^F */
}
sv_setpvn(sv,s,i);
if (tainting)
- tainted = was_tainted || rx->exec_tainted;
+ tainted = was_tainted || RX_MATCH_TAINTED(rx);
break;
}
}
}
#endif
-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32)
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
/* And you'll never guess what the dog had */
/* in its mouth... */
if (tainting) {
}
}
}
-#endif /* neither OS2 nor AMIGAOS nor WIN32 */
+#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
return 0;
}
int
magic_setisa(SV *sv, MAGIC *mg)
{
+ HV *stash;
+ SV **svp;
+ I32 fill;
+ HV *basefields = Nullhv;
+ GV **gvp;
+ GV *gv;
+ HE *he;
+ static char *FIELDS = "FIELDS";
+
sub_generation++;
+
+ if (mg->mg_type == 'i')
+ return 0; /* Ignore lower-case version of the magic */
+
+ stash = GvSTASH(mg->mg_obj);
+ svp = AvARRAY((AV*)sv);
+
+ for (fill = AvFILL((AV*)sv); fill >= 0; fill--, svp++) {
+ HV *basestash = gv_stashsv(*svp, FALSE);
+
+ if (!basestash) {
+ if (dowarn)
+ warn("No such package \"%_\" in @ISA assignment", *svp);
+ continue;
+ }
+ gvp = (GV**)hv_fetch(basestash, FIELDS, 6, FALSE);
+ if (gvp && *gvp && GvHV(*gvp)) {
+ if (basefields)
+ croak("Can't multiply inherit %%FIELDS");
+ basefields = GvHV(*gvp);
+ }
+ }
+
+ if (!basefields)
+ return 0;
+
+ gv = (GV*)*hv_fetch(stash, FIELDS, 6, TRUE);
+ if (!isGV(gv))
+ gv_init(gv, stash, FIELDS, 6, TRUE);
+ if (!GvHV(gv))
+ GvHV(gv) = newHV();
+ if (HvKEYS(GvHV(gv)))
+ croak("Inherited %%FIELDS can't override existing %%FIELDS");
+
+ hv_iterinit(GvHV(gv));
+ while ((he = hv_iternext(basefields)))
+ hv_store(GvHV(gv), HeKEY(he), HeKLEN(he), HeVAL(he), HeHASH(he));
+
return 0;
}
return 0;
}
+int
+magic_freeregexp(SV *sv, MAGIC *mg)
+{
+ regexp *re = (regexp *)mg->mg_obj;
+ ReREFCNT_dec(re);
+ return 0;
+}
+
#ifdef USE_LOCALE_COLLATE
int
magic_setcollxfrm(SV *sv, MAGIC *mg)
#ifdef VMS
set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
#else
+#ifdef WIN32
+ SetLastError( SvIV(sv) );
+#else
/* will anyone ever use this? */
SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
#endif
+#endif
break;
case '\006': /* ^F */
maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
sighandler(int sig)
{
dSP;
- GV *gv;
+ GV *gv = Nullgv;
HV *st;
SV *sv, *tSv = Sv;
- CV *cv;
+ CV *cv = Nullcv;
AV *oldstack;
OP *myop = op;
U32 flags = 0;
if (!cv || !CvROOT(cv)) {
if (dowarn)
warn("SIG%s handler \"%s\" not defined.\n",
- sig_name[sig], GvENAME(gv) );
- return;
+ sig_name[sig], (gv ? GvENAME(gv)
+ : ((cv && CvGV(cv))
+ ? GvENAME(CvGV(cv))
+ : "__ANON__")));
+ goto cleanup;
}
oldstack = curstack;
perl_call_sv((SV*)cv, G_DISCARD);
SWITCHSTACK(signalstack, oldstack);
+cleanup:
if (flags & 1)
savestack_ix -= 8; /* Unprotect save in progress. */
if (flags & 2) {