Remove now-unnecessary check. (It's done earlier)

[perl5.git] / XSUB.h

diff --git a/XSUB.h b/XSUB.h
index 4a1079f..8d8de8d 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -67,6 +67,14 @@ This is usually handled automatically by C<xsubpp>.
 Sets up the C<ix> variable for an XSUB which has aliases.  This is usually
 handled automatically by C<xsubpp>.
 
+=for apidoc Ams||dUNDERBAR
+Sets up the C<padoff_du> variable for an XSUB that wishes to use
+C<UNDERBAR>.
+
+=for apidoc AmU||UNDERBAR
+The SV* corresponding to the $_ variable. Works even if there
+is a lexical $_ in scope.
+
 =cut
 */
 
@@ -106,6 +114,11 @@ handled automatically by C<xsubpp>.
 #define XSINTERFACE_FUNC_SET(cv,f)     \
                CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f)
 
+#define dUNDERBAR I32 padoff_du = find_rundefsvoffset()
+#define UNDERBAR ((padoff_du == NOT_IN_PAD \
+           || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR) \
+       ? DEFSV : PAD_SVl(padoff_du))
+
 /* Simple macros to put new mortal values onto the stack.   */
 /* Typically used to return values from XS functions.       */
 
@@ -166,7 +179,7 @@ Return an empty list from an XSUB immediately.
 
 =head1 Variables created by C<xsubpp> and C<xsubpp> internal functions
 
-=for apidoc AmU||newXSproto
+=for apidoc AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto
 Used by C<xsubpp> to hook up XSUBs as Perl subs.  Adds Perl prototypes to
 the subs.
 
@@ -213,23 +226,29 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
 #ifdef XS_VERSION
 #  define XS_VERSION_BOOTCHECK \
     STMT_START {                                                       \
-       SV *tmpsv; STRLEN n_a;                                          \
+       SV *_sv; STRLEN n_a;                                            \
        char *vn = Nullch, *module = SvPV(ST(0),n_a);                   \
        if (items >= 2)  /* version supplied as bootstrap arg */        \
-           tmpsv = ST(1);                                              \
+           _sv = ST(1);                                                \
        else {                                                          \
            /* XXX GV_ADDWARN */                                        \
-           tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module,            \
+           _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,              \
                                vn = "XS_VERSION"), FALSE);             \
-           if (!tmpsv || !SvOK(tmpsv))                                 \
-               tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module,        \
+           if (!_sv || !SvOK(_sv))                                     \
+               _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,  \
                                    vn = "VERSION"), FALSE);            \
        }                                                               \
-       if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a))))     \
-           Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,\
-                 module, XS_VERSION,                                   \
-                 vn ? "$" : "", vn ? module : "", vn ? "::" : "",      \
-                 vn ? vn : "bootstrap parameter", tmpsv);              \
+       if (_sv) {                                                      \
+           SV *xssv = Perl_newSVpvf(aTHX_ "%s",XS_VERSION);            \
+           xssv = new_version(xssv);                                   \
+           if ( !sv_derived_from(_sv, "version") )                     \
+               _sv = new_version(_sv);                         \
+           if ( vcmp(_sv,xssv) )                                       \
+               Perl_croak(aTHX_ "%s object version %"SVf" does not match %s%s%s%s %"SVf,\
+                     module, vstringify(xssv),                         \
+                     vn ? "$" : "", vn ? module : "", vn ? "::" : "",  \
+                     vn ? vn : "bootstrap parameter", vstringify(_sv));\
+       }                                                               \
     } STMT_END
 #else
 #  define XS_VERSION_BOOTCHECK
@@ -267,6 +286,8 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
            SAVEINT(db->filtering) ;                            \
            db->filtering = TRUE ;                              \
            SAVESPTR(DEFSV) ;                                   \
+            if (name[7] == 's')                                 \
+                arg = newSVsv(arg);                             \
            DEFSV = arg ;                                       \
            SvTEMP_off(arg) ;                                   \
            PUSHMARK(SP) ;                                      \
@@ -276,6 +297,10 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
            PUTBACK ;                                           \
            FREETMPS ;                                          \
            LEAVE ;                                             \
+            if (name[7] == 's'){                                \
+                arg = sv_2mortal(arg);                          \
+            }                                                   \
+            SvOKp(arg);                                         \
        }
 
 #if 1          /* for compatibility */