[perl #30661] autoload sort subs

diff --git a/pp_sort.c b/pp_sort.c
index fd2f28a..8dacd74 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1516,7 +1516,9 @@ PP(pp_sort)
            stash = CopSTASH(PL_curcop);
        }
        else {
            stash = CopSTASH(PL_curcop);
        }
        else {

-           cv = sv_2cv(*++MARK, &stash, &gv, 0);
+           GV *autogv = NULL;
+           cv = sv_2cv(*++MARK, &stash, &gv, GV_ADD);
+         check_cv:

            if (cv && SvPOK(cv)) {
                const char * const proto = SvPV_nolen_const(MUTABLE_SV(cv));
                if (proto && strEQ(proto, "$$")) {
            if (cv && SvPOK(cv)) {
                const char * const proto = SvPV_nolen_const(MUTABLE_SV(cv));
                if (proto && strEQ(proto, "$$")) {


@@ -1528,10 +1530,26 @@ PP(pp_sort)
                    is_xsub = 1;
                }
                else if (gv) {
                    is_xsub = 1;
                }
                else if (gv) {

+                   goto autoload;
+               }
+               else if (!CvANON(cv) && (gv = CvGV(cv))) {
+                 if (cv != GvCV(gv)) cv = GvCV(gv);
+                autoload:
+                 if (!autogv && (
+                       autogv = gv_autoload_pvn(
+                           GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+                           GvNAMEUTF8(gv) ? SVf_UTF8 : 0
+                       )
+                    )) {
+                   cv = GvCVu(autogv);
+                   goto check_cv;
+                 }
+                 else {

                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
                    DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
                        SVfARG(tmpstr));
                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
                    DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
                        SVfARG(tmpstr));

+                 }

                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");
                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");

diff --git a/t/op/sort.t b/t/op/sort.t
index 73773b2..2ab0cf5 100644 (file)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
     require 'test.pl';
 }
 use warnings;

-plan( tests => 162 );
+plan( tests => 165 );

 
 # these shouldn't hang
 {
 
 # these shouldn't hang
 {


@@ -938,3 +938,14 @@ fresh_perl_is
   like $output, qr/^(?:Win)+\z/,
    'Match vars do not leak from one $$ sort sub to the next';
 }
   like $output, qr/^(?:Win)+\z/,
    'Match vars do not leak from one $$ sort sub to the next';
 }

+
+# [perl #30661] autoloading
+AUTOLOAD { $b <=> $a }
+sub stubbedsub;
+is join("", sort stubbedsub split//, '04381091'), '98431100',
+    'stubborn AUTOLOAD';
+is join("", sort hopefullynonexistent split//, '04381091'), '98431100',
+    'AUTOLOAD without stub';
+my $stubref = \&givemeastub;
+is join("", sort $stubref split//, '04381091'), '98431100',
+    'AUTOLOAD with stubref';