This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
refactor and regularise label/statement grammar
[perl5.git] / perlio.c
index ddcc357..1440048 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -807,17 +807,16 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
            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);
        }
@@ -1212,13 +1211,18 @@ PerlIO *
 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) {
@@ -1450,7 +1454,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
     /*
      * 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 */
@@ -2599,7 +2603,11 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
            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);
@@ -4110,7 +4118,7 @@ PerlIOBuf_get_base(pTHX_ PerlIO *f)
     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);
@@ -5157,7 +5165,7 @@ PerlIO_tmpfile(void)
      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
       */
@@ -5224,8 +5232,7 @@ Perl_PerlIO_context_layers(pTHX_ const char *mode)
     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;