Make XS sort routines work again

These stopped working when the CvROOT and CvXSUB fields were merged
in 5.10.0:

$ perl5.8.9 -le 'print sort utf8::is_utf8 2,1'
Usage: utf8::is_utf8(sv) at -e line 1.
$ perl5.10.0 -le 'print sort utf8::is_utf8 2,1'
12

(In the latter case, the utf8::is_utf8 routine is not being called.)

pp_sort has this:

	    if (!(cv && CvROOT(cv))) {
		if (cv && CvISXSUB(cv)) {

But CvROOT is the same as CvXSUB, so that block is never entered for
XSUBs, so this piece of code later on:

	    if (is_xsub)
		PL_sortcop = (OP*)cv;
	    else
		PL_sortcop = CvSTART(cv);

sets PL_sortcop to CvSTART for XSUBs, but CvSTART is NULL.  Later on,
this if condition fails:

	if (PL_sortcop) {

so the XSUB is treated as being absent.

diff --git a/MANIFEST b/MANIFEST
index a01e94b..ce44f46 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3867,6 +3867,7 @@ ext/XS-APItest/t/rmagical.t       XS::APItest extension
 ext/XS-APItest/t/rv2cv_op_cv.t test rv2cv_op_cv() API
 ext/XS-APItest/t/savehints.t   test SAVEHINTS() API
 ext/XS-APItest/t/scopelessblock.t      test recursive descent statement-sequence parsing
+ext/XS-APItest/t/sort.t                Test sort(xs_cmp ...)
 ext/XS-APItest/t/stmtasexpr.t  test recursive descent statement parsing
 ext/XS-APItest/t/stmtsasexpr.t test recursive descent statement-sequence parsing
 ext/XS-APItest/t/stuff_modify_bug.t    test for eval side-effecting source string

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 1d8a551..f5aa9bd 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3243,6 +3243,17 @@ CODE:
 OUTPUT:
     RETVAL
 
+int
+xs_cmp(int a, int b)
+CODE:
+    /* Odd sorting (odd numbers first), to make sure we are actually
+       being called */
+    RETVAL = a % 2 != b % 2
+              ? a % 2 ? -1 : 1
+              : a < b ? -1 : a == b ? 0 : 1;
+OUTPUT:
+    RETVAL
+
 
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 

diff --git a/ext/XS-APItest/t/sort.t b/ext/XS-APItest/t/sort.t
new file mode 100644 (file)
index 0000000..c7f0c71
--- /dev/null
+++ b/ext/XS-APItest/t/sort.t
@@ -0,0 +1,10 @@
+#!perl -w
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use XS::APItest;
+
+is join("", sort xs_cmp split//, '1415926535'), '1135559246',
+  'sort treats XS cmp routines as having implicit ($$)';

diff --git a/pp_sort.c b/pp_sort.c
index 2257d2f..d527d1e 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1525,11 +1525,11 @@ PP(pp_sort)
                    hasargs = TRUE;
                }
            }
-           if (!(cv && CvROOT(cv))) {
-               if (cv && CvISXSUB(cv)) {
-                   is_xsub = 1;
-               }
-               else if (gv) {
+           if (cv && CvISXSUB(cv) && CvXSUB(cv)) {
+               is_xsub = 1;
+           }
+           else if (!(cv && CvROOT(cv))) {
+               if (gv) {
                    goto autoload;
                }
                else if (!CvANON(cv) && (gv = CvGV(cv))) {