This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Filter::Util::Call to CPAN version 1.58
[perl5.git] / cpan / Filter-Util-Call / Call.xs
index 69f677d..74c3676 100644 (file)
@@ -2,10 +2,11 @@
  * Filename : Call.xs
  * 
  * Author   : Paul Marquess 
- * Date     : 24th April 2011
- * Version  : 1.40
+ * Date     : 2014-12-09 02:48:44 rurban
+ * Version  : 1.58
  *
  *    Copyright (c) 1995-2011 Paul Marquess. All rights reserved.
+ *    Copyright (c) 2011-2014 Reini Urban. All rights reserved.
  *       This program is free software; you can redistribute it and/or
  *              modify it under the same terms as Perl itself.
  *
@@ -59,8 +60,8 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
     int n;
 
     if (fdebug)
-       warn("**** In filter_call - maxlen = %d, out len buf = %d idx = %d my_sv = %d [%s]\n", 
-               maxlen, SvCUR(buf_sv), idx, SvCUR(my_sv), SvPVX(my_sv) ) ;
+       warn("**** In filter_call - maxlen = %d, out len buf = %" IVdf " idx = %d my_sv = %" IVdf " [%s]\n",
+             maxlen, (IV)SvCUR(buf_sv), idx, (IV)SvCUR(my_sv), SvPVX(my_sv) ) ;
 
     while (1) {
 
@@ -96,8 +97,8 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
                    BUF_OFFSET(my_sv) += (p - out_ptr + 1);
                    SvCUR_set(my_sv, n) ;
                    if (fdebug)
-                       warn("recycle %d - leaving %d, returning %d [%s]", 
-                               idx, n, SvCUR(buf_sv), SvPVX(buf_sv)) ;
+                       warn("recycle %d - leaving %d, returning %" IVdf " [%s]",
+                             idx, n, (IV)SvCUR(buf_sv), SvPVX(buf_sv)) ;
 
                    return SvCUR(buf_sv);
                }
@@ -130,19 +131,15 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
            DEFSV_set(newSVpv("", 0)) ; 
 
            PUSHMARK(sp) ;
-
            if (CODE_REF(my_sv)) {
            /* if (SvROK(PERL_OBJECT(my_sv)) && SvTYPE(SvRV(PERL_OBJECT(my_sv))) == SVt_PVCV) { */
                count = perl_call_sv((SV*)PERL_OBJECT(my_sv), G_SCALAR);
            }
            else {
                 XPUSHs((SV*)PERL_OBJECT(my_sv)) ;  
-       
                PUTBACK ;
-
                count = perl_call_method("filter", G_SCALAR);
            }
-
            SPAGAIN ;
 
             if (count != 1)
@@ -152,8 +149,8 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
            n = POPi ;
 
            if (fdebug)
-               warn("status = %d, length op buf = %d [%s]\n",
-                    n, SvCUR(DEFSV), SvPVX(DEFSV) ) ;
+               warn("status = %d, length op buf = %" IVdf " [%s]\n",
+                    n, (IV)SvCUR(DEFSV), SvPVX(DEFSV) ) ;
            if (SvCUR(DEFSV))
                sv_setpvn(my_sv, SvPVX(DEFSV), SvCUR(DEFSV)) ; 
 
@@ -171,8 +168,8 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
            /* Either EOF or an error */
 
            if (fdebug) 
-               warn ("filter_read %d returned %d , returning %d\n", idx, n,
-                   (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n);
+               warn ("filter_read %d returned %d , returning %" IVdf "\n", idx, n,
+                     (SvCUR(buf_sv)>0) ? (IV)SvCUR(buf_sv) : (IV)n);
 
            /* PERL_MODULE(my_sv) ; */
            /* PERL_OBJECT(my_sv) ; */
@@ -183,7 +180,7 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
                return n ;
 
            /* return what we have so far else signal eof */
-           return (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n;
+           return (SvCUR(buf_sv)>0) ? (int)SvCUR(buf_sv) : n;
        }
 
     }
@@ -249,16 +246,20 @@ void
 unimport(package="$Package", ...)
     const char *package
     PPCODE:
+    PERL_UNUSED_VAR(package);
     filter_del(filter_call);
 
 
 BOOT:
   {
     MY_CXT_INIT;
+#ifdef FDEBUG
+    fdebug = 1;
+#else
     fdebug = 0;
+#endif
     /* temporary hack to control debugging in toke.c */
     if (fdebug)
         filter_add(NULL, (fdebug) ? (SV*)"1" : (SV*)"0");  
   }
 
-