t/op/anonsub.t

   1 #!./perl -w
   2
   3 chdir 't' if -d 't';
   4 require './test.pl';
   5 set_up_inc('../lib');
   6
   7 use strict;
   8
   9 $|=1;
  10
  11 run_multiple_progs('', \*DATA);
  12
  13 foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
  14     eval $code;
  15     like($@, qr/^Illegal declaration of anonymous subroutine at/,
  16          "'$code' is illegal");
  17 }
  18
  19 {
  20     local $::TODO;
  21     $::TODO = 'RT #17589 not completely resolved';
  22     # Here's a patch. It makes "sub;" and similar report an error immediately
  23     # from the lexer. However the solution is not complete, it doesn't
  24     # handle the case "sub ($) : lvalue;" (marked as a TODO test), because
  25     # it's handled by the lexer in separate tokens, hence more difficult to
  26     # work out.
  27     my $code = 'sub ($) : lvalue;';
  28     eval $code;
  29     like($@, qr/^Illegal declaration of anonymous subroutine at/,
  30          "'$code' is illegal");
  31 }
  32
  33 eval "sub #foo\n{print 1}";
  34 is($@, '');
  35
  36 done_testing();
  37
  38 __END__
  39 sub X {
  40     my $n = "ok 1\n";
  41     sub { print $n };
  42 }
  43 my $x = X();
  44 undef &X;
  45 $x->();
  46 EXPECT
  47 ok 1
  48 ########
  49 sub X {
  50     my $n = "ok 1\n";
  51     sub {
  52         my $dummy = $n; # eval can't close on $n without internal reference
  53         eval 'print $n';
  54         die $@ if $@;
  55     };
  56 }
  57 my $x = X();
  58 undef &X;
  59 $x->();
  60 EXPECT
  61 ok 1
  62 ########
  63 sub X {
  64     my $n = "ok 1\n";
  65     eval 'sub { print $n }';
  66 }
  67 my $x = X();
  68 die $@ if $@;
  69 undef &X;
  70 $x->();
  71 EXPECT
  72 ok 1
  73 ########
  74 sub X;
  75 sub X {
  76     my $n = "ok 1\n";
  77     eval 'sub Y { my $p = shift; $p->() }';
  78     die $@ if $@;
  79     Y(sub { print $n });
  80 }
  81 X();
  82 EXPECT
  83 ok 1
  84 ########
  85 print sub { return "ok 1\n" } -> ();
  86 EXPECT
  87 ok 1
  88 ########
  89 my @void_warnings;
  90 {
  91     use warnings;
  92     local $SIG{'__WARN__'} = sub { push @void_warnings, @_ };
  93     sub { 1 };
  94     1
  95 }
  96 "@void_warnings"
  97 EXPECT
  98 Useless use of anonymous subroutine in void context at - line 5.
  99 ########
 100 # [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
 101 sub __ANON__ { print "42\n" }
 102 undef &{$x=sub{}};
 103 $x->();
 104 EXPECT
 105 Undefined subroutine called at - line 4.
 106 ########
 107 # NAME anon constant clobbering __ANON__
 108 sub __ANON__ { "42\n" }
 109 print __ANON__;
 110 sub(){3};
 111 EXPECT
 112 42
 113 ########
 114 # NAME undef &anon giving it a freed GV
 115 $_ = sub{};
 116 delete $::{__ANON__};
 117 undef &$_; # SvREFCNT_dec + inc on a GV with a refcnt of 1
 118            # so now SvTYPE(CvGV(anon)) is 0xff == freed
 119 if (!eval { require B }) { # miniperl, presumably
 120     print "__ANON__\n";
 121 } else {
 122     print B::svref_2object($_)->GV->NAME, "\n";
 123 }
 124 EXPECT
 125 __ANON__