SV * const layer = newSVpvn(name, len);
CV * const cv = get_cvs("PerlIO::Layer::NoWarnings", 0);
ENTER;
- SAVEINT(PL_in_load_module);
+ SAVEBOOL(PL_in_load_module);
if (cv) {
SAVEGENERICSV(PL_warnhook);
PL_warnhook = MUTABLE_SV((SvREFCNT_inc_simple_NN(cv)));
}
- PL_in_load_module++;
+ PL_in_load_module = TRUE;
/*
* The two SVs are magically freed by load_module
*/
Perl_load_module(aTHX_ 0, pkgsv, NULL, layer, NULL);
- PL_in_load_module--;
LEAVE;
return PerlIO_find_layer(aTHX_ name, len, 0);
}
PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
{
if (tab->fsize != sizeof(PerlIO_funcs)) {
- mismatch:
- Perl_croak(aTHX_ "Layer does not match this perl");
+ Perl_croak( aTHX_
+ "%s (%d) does not match %s (%d)",
+ "PerlIO layer function table size", tab->fsize,
+ "size expected by this perl", sizeof(PerlIO_funcs) );
}
if (tab->size) {
PerlIOl *l;
if (tab->size < sizeof(PerlIOl)) {
- goto mismatch;
+ Perl_croak( aTHX_
+ "%s (%d) smaller than %s (%d)",
+ "PerlIO layer instance size", tab->size,
+ "size expected by this perl", sizeof(PerlIOl) );
}
/* Real layer with a data area */
if (f) {
/*
* For any scalar type load the handler which is bundled with perl
*/
- if (SvTYPE(sv) < SVt_PVAV) {
+ if (SvTYPE(sv) < SVt_PVAV && (!isGV_with_GP(sv) || SvFAKE(sv))) {
PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1);
/* This isn't supposed to happen, since PerlIO::scalar is core,
* but could happen anyway in smaller installs or with PAR */
mode++;
else {
imode = PerlIOUnix_oflags(mode);
+#ifdef VMS
+ perm = 0777; /* preserve RMS defaults, ACL inheritance, etc. */
+#else
perm = 0666;
+#endif
}
if (imode != -1) {
const char *path = SvPV_nolen_const(*args);
if (!b->buf) {
if (!b->bufsiz)
b->bufsiz = 4096;
- b->buf = Newxz(b->buf,b->bufsiz, STDCHAR);
+ Newxz(b->buf,b->bufsiz, STDCHAR);
if (!b->buf) {
b->buf = (STDCHAR *) & b->oneword;
b->bufsiz = sizeof(b->oneword);
int fd = -1;
char tempname[] = "/tmp/PerlIO_XXXXXX";
const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR");
- SV * sv;
+ SV * sv = NULL;
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
if (!direction)
return NULL;
- layers = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
- 0, direction, 5, 0, 0);
+ layers = cop_hints_fetch_pvn(PL_curcop, direction, 5, 0, 0);
assert(layers);
return SvOK(layers) ? SvPV_nolen_const(layers) : NULL;