t/op/anonsub.t

   1 #!./perl -w
   2
   3 chdir 't' if -d 't';
   4 @INC = '../lib';
   5 require './test.pl';
   6 use strict;
   7
   8 $|=1;
   9
  10 run_multiple_progs('', \*DATA);
  11
  12 foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
  13     eval $code;
  14     like($@, qr/^Illegal declaration of anonymous subroutine at/,
  15          "'$code' is illegal");
  16 }
  17
  18 {
  19     local $::TODO;
  20     $::TODO = 'RT #17589 not completely resolved';
  21     # Here's a patch. It makes "sub;" and similar report an error immediately
  22     # from the lexer. However the solution is not complete, it doesn't
  23     # handle the case "sub ($) : lvalue;" (marked as a TODO test), because
  24     # it's handled by the lexer in separate tokens, hence more difficult to
  25     # work out.
  26     my $code = 'sub ($) : lvalue;';
  27     eval $code;
  28     like($@, qr/^Illegal declaration of anonymous subroutine at/,
  29          "'$code' is illegal");
  30 }
  31
  32 eval "sub #foo\n{print 1}";
  33 is($@, '');
  34
  35 done_testing();
  36
  37 __END__
  38 sub X {
  39     my $n = "ok 1\n";
  40     sub { print $n };
  41 }
  42 my $x = X();
  43 undef &X;
  44 $x->();
  45 EXPECT
  46 ok 1
  47 ########
  48 sub X {
  49     my $n = "ok 1\n";
  50     sub {
  51         my $dummy = $n; # eval can't close on $n without internal reference
  52         eval 'print $n';
  53         die $@ if $@;
  54     };
  55 }
  56 my $x = X();
  57 undef &X;
  58 $x->();
  59 EXPECT
  60 ok 1
  61 ########
  62 sub X {
  63     my $n = "ok 1\n";
  64     eval 'sub { print $n }';
  65 }
  66 my $x = X();
  67 die $@ if $@;
  68 undef &X;
  69 $x->();
  70 EXPECT
  71 ok 1
  72 ########
  73 sub X;
  74 sub X {
  75     my $n = "ok 1\n";
  76     eval 'sub Y { my $p = shift; $p->() }';
  77     die $@ if $@;
  78     Y(sub { print $n });
  79 }
  80 X();
  81 EXPECT
  82 ok 1
  83 ########
  84 print sub { return "ok 1\n" } -> ();
  85 EXPECT
  86 ok 1
  87 ########
  88 # [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
  89 undef &{$x=sub{}};
  90 $x->();
  91 EXPECT
  92 Undefined subroutine called at - line 3.