+XS(XS_re_regexp_pattern)
+{
+ dVAR;
+ dXSARGS;
+ REGEXP *re;
+
+ if (items != 1)
+ croak_xs_usage(cv, "sv");
+
+ SP -= items;
+
+ /*
+ Checks if a reference is a regex or not. If the parameter is
+ not a ref, or is not the result of a qr// then returns false
+ in scalar context and an empty list in list context.
+ Otherwise in list context it returns the pattern and the
+ modifiers, in scalar context it returns the pattern just as it
+ would if the qr// was stringified normally, regardless as
+ to the class of the variable and any strigification overloads
+ on the object.
+ */
+
+ if ((re = SvRX(ST(0)))) /* assign deliberate */
+ {
+ /* Housten, we have a regex! */
+ SV *pattern;
+ STRLEN left = 0;
+ char reflags[6];
+
+ if ( GIMME_V == G_ARRAY ) {
+ /*
+ we are in list context so stringify
+ the modifiers that apply. We ignore "negative
+ modifiers" in this scenario.
+ */
+
+ const char *fptr = INT_PAT_MODS;
+ char ch;
+ U16 match_flags = (U16)((RX_EXTFLAGS(re) & PMf_COMPILETIME)
+ >> RXf_PMf_STD_PMMOD_SHIFT);
+
+ while((ch = *fptr++)) {
+ if(match_flags & 1) {
+ reflags[left++] = ch;
+ }
+ match_flags >>= 1;
+ }
+
+ pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
+ (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
+
+ /* return the pattern and the modifiers */
+ XPUSHs(pattern);
+ XPUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
+ XSRETURN(2);
+ } else {
+ /* Scalar, so use the string that Perl would return */
+ /* return the pattern in (?msix:..) format */
+#if PERL_VERSION >= 11
+ pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
+#else
+ pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
+ (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
+#endif
+ XPUSHs(pattern);
+ XSRETURN(1);
+ }
+ } else {
+ /* It ain't a regexp folks */
+ if ( GIMME_V == G_ARRAY ) {
+ /* return the empty list */
+ XSRETURN_UNDEF;
+ } else {
+ /* Because of the (?:..) wrapping involved in a
+ stringified pattern it is impossible to get a
+ result for a real regexp that would evaluate to
+ false. Therefore we can return PL_sv_no to signify
+ that the object is not a regex, this means that one
+ can say
+
+ if (regex($might_be_a_regex) eq '(?:foo)') { }
+
+ and not worry about undefined values.
+ */
+ XSRETURN_NO;
+ }
+ }
+ /* NOT-REACHED */
+}
+