sort does not call get-magic after dereffing

sort $f @list accepts a globref for $f, and probably has since Perl
5.000, even if it was by mistake that it ever worked.

It doesn’t respect get-magic, however:

$ perl -le 'sub s { $b <=> $a }; $f = \*s; print sort $f 1,2,3'
321
$ ./perl -Ilib -le '
    sub TIESCALAR{bless[]}
    sub FETCH {*s}
    sub s { $b <=> $a };
    tie $f, "";
    $g = \$f;
    print sort $g 1,2,3'
Not a subroutine reference at -e line 1.

Interestingly, this commit added support for sort $coderef @foo:

commit 7a4920e67d1e2d67a4397a908141c6608866ebb0
Author: Graham Barr <gbarr@pobox.com>
Date:   Fri Nov 27 05:16:50 1998 +0000

    integrate change#2246 from mainline, while still allowing
    C<sort $globref @foo>

    allow C<sort $coderef @foo>

    p4raw-link: @2246 on //depot/perl: c6e96bcb406bc8b8d8610606459ff606ad6883aa

    p4raw-id: //depot/maint-5.005/perl@2315
    p4raw-integrated: from //depot/perl@2314 'merge in' t/op/sort.t
    	(@1760..)

If I’m reading this code correctly, it did so by nulling out whatever
op used to come after the pushmark (now it is always a null):

$ perl -MO=Concise -e 'sort $fo @fo'8  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 1 -e:1) v:{ ->3
7     <@> sort vKS ->8
3        <0> pushmark s ->4
-        <1> null K/1 ->5           <--- Lo!
-           <1> ex-rv2sv sK/1 ->-
4              <#> gvsv[*fo] s ->5
6        <1> rv2av[t3] lK/1 ->7
5           <#> gv[*fo] s ->6
-e syntax OK

To preserve the globref support (which the nulled op was providing
before), it added it to sv_2cv, which was the wrong place if you ask
me.  Now it means that &{\*_} works, in addition to &{*_}.  Other
deref ops don’t have this property.  Bug?  Maybe.  But we can just
pretend it’s a feature and live with it.

In any case, extracting the entry of a typeglob without calling get-
magic on it first doesn’t seem right.

diff --git a/sv.c b/sv.c
index f00d01f..7ddb222 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8916,7 +8916,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
                *st = CvSTASH(cv);
                return cv;
            }
-           else if(isGV_with_GP(sv))
+           else if(SvGETMAGIC(sv), isGV_with_GP(sv))
                gv = MUTABLE_GV(sv);
            else
                Perl_croak(aTHX_ "Not a subroutine reference");

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index f308c33..e4fe5f4 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 289);
+    plan (tests => 291);
 }
 
 use strict;
@@ -210,14 +210,16 @@ $var8->bolgy            ; check_count '->method';
 
 # Functions that operate on filenames or filehandles
 for ([chdir=>''],[chmod=>'0,'],[chown=>'0,0,'],[utime=>'0,0,'],
-     [truncate=>'',',0'],[stat=>''],[lstat=>''],[open=>'my $fh,"<&",']) {
+     [truncate=>'',',0'],[stat=>''],[lstat=>''],[open=>'my $fh,"<&",'],
+     ['()=sort'=>'',' 1,2,3']) {
     my($op,$args,$postargs) = @$_; $postargs //= '';
     # This line makes $var8 hold a glob:
     $var8 = *dummy; $dummy = $var8; $count = 0;
     eval "$op $args \$var8 $postargs";
     check_count "$op $args\$tied_glob$postargs";
     $var8 = *dummy; $dummy = $var8; $count = 0;
-    eval "$op $args \\\$var8 $postargs";
+    my $ref = \$var8;
+    eval "$op $args \$ref $postargs";
     check_count "$op $args\\\$tied_glob$postargs";
 }