Upgrade to podlators-2.0.2

[p5sagit/p5-mst-13.2.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 49b1b2d..cb7f62b 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1,5 +1,5 @@
 /*
- * perlio.c Copyright (c) 1996-2005, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2006, Nick Ing-Simmons You may distribute
  * under the terms of either the GNU General Public License or the
  * Artistic License, as specified in the README file.
  */
@@ -480,7 +480,7 @@ PerlIO_debug(const char *fmt, ...)
 #else
        const char *s = CopFILE(PL_curcop);
        STRLEN len;
-       SV * const sv = newSVpvn("", 0);
+       SV * const sv = newSVpvs("");
        Perl_sv_catpvf(aTHX_ sv, "%s:%" IVdf " ", s ? s : "(none)",
                       (IV) CopLINE(PL_curcop));
        Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
@@ -507,6 +507,7 @@ PerlIO_debug(const char *fmt, ...)
 PerlIO *
 PerlIO_allocate(pTHX)
 {
+    dVAR;
     /*
      * Find a free slot in the table, allocating new table as necessary
      */
@@ -598,6 +599,7 @@ PerlIO_list_free(pTHX_ PerlIO_list_t *list)
 void
 PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
 {
+    dVAR;
     PerlIO_pair_t *p;
     if (list->cur >= list->len) {
        list->len += 8;
@@ -660,6 +662,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
 void
 PerlIO_destruct(pTHX)
 {
+    dVAR;
     PerlIO **table = &PL_perlio;
     PerlIO *f;
 #ifdef USE_ITHREADS
@@ -715,6 +718,7 @@ PerlIO_pop(pTHX_ PerlIO *f)
 AV *
 PerlIO_get_layers(pTHX_ PerlIO *f)
 {
+    dVAR;
     AV * const av = newAV();
 
     if (PerlIOValid(f)) {
@@ -760,7 +764,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
            Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer");
            return NULL;
        } else {
-           SV * const pkgsv = newSVpvn("PerlIO", 6);
+           SV * const pkgsv = newSVpvs("PerlIO");
            SV * const layer = newSVpvn(name, len);
            CV * const cv    = get_cv("PerlIO::Layer::NoWarnings", FALSE);
            ENTER;
@@ -867,7 +871,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
 SV *
 PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
 {
-    HV * const stash = gv_stashpv("PerlIO::Layer", TRUE);
+    HV * const stash = gv_stashpvs("PerlIO::Layer", TRUE);
     SV * const sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash);
     return sv;
 }
@@ -877,6 +881,7 @@ XS(XS_PerlIO__Layer__NoWarnings)
     /* This is used as a %SIG{__WARN__} handler to supress warnings
        during loading of layers.
      */
+    dVAR;
     dXSARGS;
     if (items)
        PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
@@ -885,6 +890,7 @@ XS(XS_PerlIO__Layer__NoWarnings)
 
 XS(XS_PerlIO__Layer__find)
 {
+    dVAR;
     dXSARGS;
     if (items < 2)
        Perl_croak(aTHX_ "Usage class->find(name[,load])");
@@ -903,6 +909,7 @@ XS(XS_PerlIO__Layer__find)
 void
 PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
 {
+    dVAR;
     if (!PL_known_layers)
        PL_known_layers = PerlIO_list_alloc(aTHX);
     PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
@@ -912,6 +919,7 @@ PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
 int
 PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 {
+    dVAR;
     if (names) {
        const char *s = names;
        while (*s) {
@@ -1005,6 +1013,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 void
 PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
 {
+    dVAR;
     PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio;
 #ifdef PERLIO_USING_CRLF
     tab = &PerlIO_crlf;
@@ -1084,6 +1093,7 @@ PERLIO_FUNCS_DECL(PerlIO_remove) = {
 PerlIO_list_t *
 PerlIO_default_layers(pTHX)
 {
+    dVAR;
     if (!PL_def_layerlist) {
        const char * const s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
        PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
@@ -1135,6 +1145,7 @@ Perl_boot_core_PerlIO(pTHX)
 PerlIO_funcs *
 PerlIO_default_layer(pTHX_ I32 n)
 {
+    dVAR;
     PerlIO_list_t * const av = PerlIO_default_layers(aTHX);
     if (n < 0)
        n += av->cur;
@@ -1147,6 +1158,7 @@ PerlIO_default_layer(pTHX_ I32 n)
 void
 PerlIO_stdstreams(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
        PerlIO_allocate(aTHX);
        PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
@@ -1378,12 +1390,14 @@ Perl_PerlIO_close(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_fileno(pTHX_ PerlIO *f)
 {
+    dVAR;
      Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
 }
 
 static const char *
 PerlIO_context_layers(pTHX_ const char *mode)
 {
+    dVAR;
     const char *type = NULL;
     /*
      * Need to supply default layer info from open.pm
@@ -1410,24 +1424,25 @@ PerlIO_context_layers(pTHX_ const char *mode)
 static PerlIO_funcs *
 PerlIO_layer_from_ref(pTHX_ SV *sv)
 {
+    dVAR;
     /*
      * For any scalar type load the handler which is bundled with perl
      */
     if (SvTYPE(sv) < SVt_PVAV)
-       return PerlIO_find_layer(aTHX_ "scalar", 6, 1);
+       return PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1);
 
     /*
      * For other types allow if layer is known but don't try and load it
      */
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
-       return PerlIO_find_layer(aTHX_ "Array", 5, 0);
+       return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Array"), 0);
     case SVt_PVHV:
-       return PerlIO_find_layer(aTHX_ "Hash", 4, 0);
+       return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Hash"), 0);
     case SVt_PVCV:
-       return PerlIO_find_layer(aTHX_ "Code", 4, 0);
+       return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0);
     case SVt_PVGV:
-       return PerlIO_find_layer(aTHX_ "Glob", 4, 0);
+       return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0);
     }
     return NULL;
 }
@@ -1436,6 +1451,7 @@ PerlIO_list_t *
 PerlIO_resolve_layers(pTHX_ const char *layers,
                      const char *mode, int narg, SV **args)
 {
+    dVAR;
     PerlIO_list_t *def = PerlIO_default_layers(aTHX);
     int incdef = 1;
     if (!PL_perlio)
@@ -1494,6 +1510,7 @@ PerlIO *
 PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
             int imode, int perm, PerlIO *f, int narg, SV **args)
 {
+    dVAR;
     if (!f && narg == 1 && *args == &PL_sv_undef) {
        if ((f = PerlIO_tmpfile())) {
            if (!layers || !*layers)
@@ -1609,6 +1626,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_flush(pTHX_ PerlIO *f)
 {
+    dVAR;
     if (f) {
        if (*f) {
            const PerlIO_funcs *tab = PerlIOBase(f)->tab;
@@ -1650,6 +1668,7 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
 void
 PerlIOBase_flush_linebuf(pTHX)
 {
+    dVAR;
     PerlIO **table = &PL_perlio;
     PerlIO *f;
     while ((f = *table)) {
@@ -2242,6 +2261,7 @@ PerlIOUnix_refcnt_inc(int fd)
 {
     dTHX;
     if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+       dVAR;
 #ifdef USE_THREADS
        MUTEX_LOCK(&PerlIO_mutex);
 #endif
@@ -2259,6 +2279,7 @@ PerlIOUnix_refcnt_dec(int fd)
     dTHX;
     int cnt = 0;
     if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+       dVAR;
 #ifdef USE_THREADS
        MUTEX_LOCK(&PerlIO_mutex);
 #endif
@@ -2274,6 +2295,7 @@ PerlIOUnix_refcnt_dec(int fd)
 void
 PerlIO_cleanup(pTHX)
 {
+    dVAR;
     int i;
 #ifdef USE_ITHREADS
     PerlIO_debug("Cleanup layers for %p\n",aTHX);
@@ -2505,6 +2527,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 SSize_t
 PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
+    dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
 #ifdef PERLIO_STD_SPECIAL
     if (fd == 0)
@@ -2536,6 +2559,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 SSize_t
 PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
+    dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
 #ifdef PERLIO_STD_SPECIAL
     if (fd == 1 || fd == 2)
@@ -2566,6 +2590,7 @@ PerlIOUnix_tell(pTHX_ PerlIO *f)
 IV
 PerlIOUnix_close(pTHX_ PerlIO *f)
 {
+    dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
     if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
@@ -3038,6 +3063,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 SSize_t
 PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
+    dVAR;
     FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
     for (;;) {
@@ -3126,6 +3152,7 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 SSize_t
 PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
+    dVAR;
     SSize_t got;
     for (;;) {
        got = PerlSIO_fwrite(vbuf, 1, count,
@@ -4715,6 +4742,7 @@ PERLIO_FUNCS_DECL(PerlIO_mmap) = {
 PerlIO *
 Perl_PerlIO_stdin(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
@@ -4724,6 +4752,7 @@ Perl_PerlIO_stdin(pTHX)
 PerlIO *
 Perl_PerlIO_stdout(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
@@ -4733,6 +4762,7 @@ Perl_PerlIO_stdout(pTHX)
 PerlIO *
 Perl_PerlIO_stderr(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
@@ -4855,7 +4885,7 @@ int
 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
 {
     dTHX;
-    SV * const sv = newSVpvn("", 0);
+    SV * const sv = newSVpvs("");
     const char *s;
     STRLEN len;
     SSize_t wrote;
@@ -4909,7 +4939,7 @@ PerlIO_tmpfile(void)
          f = PerlIO_fdopen(fd, "w+b");
 #else /* WIN32 */
 #    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
-     SV * const sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+     SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX");
      /*
       * I have no idea how portable mkstemp() is ... NI-S
       */