t/op/lexsub.t

   1 #!perl
   2
   3 BEGIN {
   4     chdir 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7     *bar::is = *is;
   8     *bar::like = *like;
   9 }
  10 plan 130;
  11
  12 # -------------------- Errors with feature disabled -------------------- #
  13
  14 eval "#line 8 foo\nmy sub foo";
  15 is $@, qq 'Experimental "my" subs not enabled at foo line 8.\n',
  16   'my sub unexperimental error';
  17 eval "#line 8 foo\nCORE::state sub foo";
  18 is $@, qq 'Experimental "state" subs not enabled at foo line 8.\n',
  19   'state sub unexperimental error';
  20 eval "#line 8 foo\nour sub foo";
  21 is $@, qq 'Experimental "our" subs not enabled at foo line 8.\n',
  22   'our sub unexperimental error';
  23
  24 # -------------------- our -------------------- #
  25
  26 no warnings "experimental::lexical_subs";
  27 use feature 'lexical_subs';
  28 {
  29   our sub foo { 42 }
  30   is foo, 42, 'calling our sub from same package';
  31   is &foo, 42, 'calling our sub from same package (amper)';
  32   package bar;
  33   sub bar::foo { 43 }
  34   is foo, 42, 'calling our sub from another package';
  35   is &foo, 42, 'calling our sub from another package (amper)';
  36 }
  37 package bar;
  38 is foo, 43, 'our sub falling out of scope';
  39 is &foo, 43, 'our sub falling out of scope (called via amper)';
  40 package main;
  41 {
  42   sub bar::a { 43 }
  43   our sub a {
  44     if (shift) {
  45       package bar;
  46       is a, 43, 'our sub invisible inside itself';
  47       is &a, 43, 'our sub invisible inside itself (called via amper)';
  48     }
  49     42
  50   }
  51   a(1);
  52   sub bar::b { 43 }
  53   our sub b;
  54   our sub b {
  55     if (shift) {
  56       package bar;
  57       is b, 42, 'our sub visible inside itself after decl';
  58       is &b, 42, 'our sub visible inside itself after decl (amper)';
  59     }
  60     42
  61   }
  62   b(1)
  63 }
  64 sub c { 42 }
  65 sub bar::c { 43 }
  66 {
  67   our sub c;
  68   package bar;
  69   is c, 42, 'our sub foo; makes lex alias for existing sub';
  70   is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)';
  71 }
  72 {
  73   our sub d;
  74   sub bar::d { 'd43' }
  75   package bar;
  76   sub d { 'd42' }
  77   is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}';
  78 }
  79 {
  80   our sub e ($);
  81   is prototype "::e", '$', 'our sub with proto';
  82 }
  83 {
  84   our sub if() { 42 }
  85   my $x = if if if;
  86   is $x, 42, 'lexical subs (even our) override all keywords';
  87   package bar;
  88   my $y = if if if;
  89   is $y, 42, 'our subs from other packages override all keywords';
  90 }
  91 # Interaction with ‘use constant’
  92 {
  93   our sub const; # symtab now has an undefined CV
  94   BEGIN { delete $::{const} } # delete symtab entry; pad entry still exists
  95   use constant const => 3; # symtab now has a scalar ref
  96   # inlining this used to fail an assertion (parentheses necessary):
  97   is(const, 3, 'our sub pointing to "use constant" constant');
  98 }
  99
 100 # -------------------- state -------------------- #
 101
 102 use feature 'state'; # state
 103 {
 104   state sub foo { 44 }
 105   isnt \&::foo, \&foo, 'state sub is not stored in the package';
 106   is eval foo, 44, 'calling state sub from same package';
 107   is eval &foo, 44, 'calling state sub from same package (amper)';
 108   package bar;
 109   is eval foo, 44, 'calling state sub from another package';
 110   is eval &foo, 44, 'calling state sub from another package (amper)';
 111 }
 112 package bar;
 113 is foo, 43, 'state sub falling out of scope';
 114 is &foo, 43, 'state sub falling out of scope (called via amper)';
 115 {
 116   sub sa { 43 }
 117   state sub sa {
 118     if (shift) {
 119       is sa, 43, 'state sub invisible inside itself';
 120       is &sa, 43, 'state sub invisible inside itself (called via amper)';
 121     }
 122     44
 123   }
 124   sa(1);
 125   sub sb { 43 }
 126   state sub sb;
 127   state sub sb {
 128     if (shift) {
 129       # ‘state sub foo{}’ creates a new pad entry, not reusing the forward
 130       #  declaration.  Being invisible inside itself, it sees the stub.
 131       eval{sb};
 132       like $@, qr/^Undefined subroutine &sb called at /,
 133         'state sub foo {} after forward declaration';
 134       eval{&sb};
 135       like $@, qr/^Undefined subroutine &sb called at /,
 136         'state sub foo {} after forward declaration (amper)';
 137     }
 138     44
 139   }
 140   sb(1);
 141   sub sb2 { 43 }
 142   state sub sb2;
 143   sub sb2 {
 144     if (shift) {
 145       package bar;
 146       is sb2, 44, 'state sub visible inside itself after decl';
 147       is &sb2, 44, 'state sub visible inside itself after decl (amper)';
 148     }
 149     44
 150   }
 151   sb2(1);
 152   state sub sb3;
 153   {
 154     state sub sb3 { # new pad entry
 155       # The sub containing this comment is invisible inside itself.
 156       # So this one here will assign to the outer pad entry:
 157       sub sb3 { 47 }
 158     }
 159   }
 160   is eval{sb3}, 47,
 161     'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
 162   # Same test again, but inside an anonymous sub
 163   sub {
 164     state sub sb4;
 165     {
 166       state sub sb4 {
 167         sub sb4 { 47 }
 168       }
 169     }
 170     is sb4, 47,
 171       'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
 172   }->();
 173 }
 174 sub sc { 43 }
 175 {
 176   state sub sc;
 177   eval{sc};
 178   like $@, qr/^Undefined subroutine &sc called at /,
 179      'state sub foo; makes no lex alias for existing sub';
 180   eval{&sc};
 181   like $@, qr/^Undefined subroutine &sc called at /,
 182      'state sub foo; makes no lex alias for existing sub (amper)';
 183 }
 184 package main;
 185 {
 186   state sub se ($);
 187   is prototype eval{\&se}, '$', 'state sub with proto';
 188   is prototype "se", undef, 'prototype "..." ignores state subs';
 189 }
 190 {
 191   state sub if() { 44 }
 192   my $x = if if if;
 193   is $x, 44, 'state subs override all keywords';
 194   package bar;
 195   my $y = if if if;
 196   is $y, 44, 'state subs from other packages override all keywords';
 197 }
 198 {
 199   use warnings; no warnings "experimental::lexical_subs";
 200   state $w ;
 201   local $SIG{__WARN__} = sub { $w .= shift };
 202   eval '#line 87 squidges
 203     state sub foo;
 204     state sub foo {};
 205   ';
 206   is $w,
 207      '"state" subroutine &foo masks earlier declaration in same scope at '
 208    . "squidges line 88.\n",
 209      'warning for state sub masking earlier declaration';
 210 }
 211 # Since state vars inside anonymous subs are cloned at the same time as the
 212 # anonymous subs containing them, the same should happen for state subs.
 213 sub make_closure {
 214   my $x = shift;
 215   sub {
 216     state sub foo { $x }
 217     foo
 218   }
 219 }
 220 $sub1 = make_closure 48;
 221 $sub2 = make_closure 49;
 222 is &$sub1, 48, 'state sub in closure (1)';
 223 is &$sub2, 49, 'state sub in closure (2)';
 224 # But we need to test that state subs actually do persist from one invoca-
 225 # tion of a named sub to another (i.e., that they are not my subs).
 226 {
 227   use warnings; no warnings "experimental::lexical_subs";
 228   state $w;
 229   local $SIG{__WARN__} = sub { $w .= shift };
 230   eval '#line 65 teetet
 231     sub foom {
 232       my $x = shift;
 233       state sub poom { $x }
 234       eval{\&poom}
 235     }
 236   ';
 237   is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
 238          'state subs get "Variable will not stay shared" messages';
 239   my $poom = foom(27);
 240   my $poom2 = foom(678);
 241   is eval{$poom->()}, eval {$poom2->()},
 242     'state subs close over the first outer my var, like pkg subs';
 243   my $x = 43;
 244   for $x (765) {
 245     state sub etetetet { $x }
 246     is eval{etetetet}, 43, 'state sub ignores for() localisation';
 247   }
 248 }
 249 # And we also need to test that multiple state subs can close over each
 250 # other’s entries in the parent subs pad, and that cv_clone is not con-
 251 # fused by that.
 252 sub make_anon_with_state_sub{
 253   sub {
 254     state sub s1;
 255     state sub s2 { \&s1 }
 256     sub s1 { \&s2 }
 257     if (@_) { return \&s1 }
 258     is s1,\&s2, 'state sub in anon closure closing over sibling state sub';
 259     is s2,\&s1, 'state sub in anon closure closing over sibling state sub';
 260   }
 261 }
 262 {
 263   my $s = make_anon_with_state_sub;
 264   &$s;
 265
 266   # And make sure the state subs were actually cloned.
 267   isnt make_anon_with_state_sub->(0), &$s(0),
 268     'state subs in anon subs are cloned';
 269   is &$s(0), &$s(0), 'but only when the anon sub is cloned';
 270 }
 271 {
 272   state sub BEGIN { exit };
 273   pass 'state subs are never special blocks';
 274   state sub END { shift }
 275   is eval{END('jkqeudth')}, jkqeudth,
 276     'state sub END {shift} implies @_, not @ARGV';
 277   state sub CORE { scalar reverse shift }
 278   is CORE::uc("hello"), "HELLO",
 279     'lexical CORE does not interfere with CORE::...';
 280 }
 281 {
 282   state sub redef {}
 283   use warnings; no warnings "experimental::lexical_subs";
 284   state $w;
 285   local $SIG{__WARN__} = sub { $w .= shift };
 286   eval "#line 56 pygpyf\nsub redef {}";
 287   is $w, "Subroutine redef redefined at pygpyf line 56.\n",
 288          "sub redefinition warnings from state subs";
 289 }
 290 {
 291   state sub p (\@) {
 292     is ref $_[0], 'ARRAY', 'state sub with proto';
 293   }
 294   p(my @a);
 295   p my @b;
 296   state sub q () { 45 }
 297   is q(), 45, 'state constant called with parens';
 298 }
 299 {
 300   state sub x;
 301   eval 'sub x {3}';
 302   is x, 3, 'state sub defined inside eval';
 303
 304   sub r {
 305     state sub foo { 3 };
 306     if (@_) { # outer call
 307       r();
 308       is foo(), 42,
 309          'state sub run-time redefinition applies to all recursion levels';
 310     }
 311     else { # inner call
 312       eval 'sub foo { 42 }';
 313     }
 314   }
 315   r(1);
 316 }
 317 like runperl(
 318       switches => [ '-Mfeature=lexical_subs,state' ],
 319       prog     => 'state sub a { foo ref } a()',
 320       stderr   => 1
 321      ),
 322      qr/syntax error/,
 323     'referencing a state sub after a syntax error does not crash';
 324 {
 325   state $stuff;
 326   package A {
 327     state sub foo{ $stuff .= our $AUTOLOAD }
 328     *A::AUTOLOAD = \&foo;
 329   }
 330   A::bar();
 331   is $stuff, 'A::bar', 'state sub assigned to *AUTOLOAD can autoload';
 332 }
 333 {
 334   state sub quire{qr "quires"}
 335   package o { use overload qr => \&quire }
 336   ok "quires" =~ bless([], o::), 'state sub used as overload method';
 337 }
 338 {
 339   state sub foo;
 340   *cvgv = \&foo;
 341   local *cvgv2 = *cvgv;
 342   eval 'sub cvgv2 {42}'; # uses the stub already present
 343   is foo, 42, 'defining state sub body via package sub declaration';
 344 }
 345 {
 346   local $ENV{PERL5DB} = 'sub DB::DB{}';
 347   is(
 348     runperl(
 349      switches => [ '-d' ],
 350      progs => [ split "\n",
 351       'use feature qw - lexical_subs state -;
 352        no warnings q-experimental::lexical_subs-;
 353        sub DB::sub{ print qq|4\n|; goto $DB::sub }
 354        state sub foo {print qq|2\n|}
 355        foo();
 356       '
 357      ],
 358      stderr => 1
 359     ),
 360     "4\n2\n",
 361     'state subs and DB::sub under -d'
 362   );
 363 }
 364
 365 # -------------------- my -------------------- #
 366
 367 {
 368   my sub foo { 44 }
 369   isnt \&::foo, \&foo, 'my sub is not stored in the package';
 370   is foo, 44, 'calling my sub from same package';
 371   is &foo, 44, 'calling my sub from same package (amper)';
 372   package bar;
 373   is foo, 44, 'calling my sub from another package';
 374   is &foo, 44, 'calling my sub from another package (amper)';
 375 }
 376 package bar;
 377 is foo, 43, 'my sub falling out of scope';
 378 is &foo, 43, 'my sub falling out of scope (called via amper)';
 379 {
 380   sub ma { 43 }
 381   my sub ma {
 382     if (shift) {
 383       is ma, 43, 'my sub invisible inside itself';
 384       is &ma, 43, 'my sub invisible inside itself (called via amper)';
 385     }
 386     44
 387   }
 388   ma(1);
 389   sub mb { 43 }
 390   my sub mb;
 391   my sub mb {
 392     if (shift) {
 393       # ‘my sub foo{}’ creates a new pad entry, not reusing the forward
 394       #  declaration.  Being invisible inside itself, it sees the stub.
 395       eval{mb};
 396       like $@, qr/^Undefined subroutine &mb called at /,
 397         'my sub foo {} after forward declaration';
 398       eval{&mb};
 399       like $@, qr/^Undefined subroutine &mb called at /,
 400         'my sub foo {} after forward declaration (amper)';
 401     }
 402     44
 403   }
 404   mb(1);
 405   sub mb2 { 43 }
 406   my sub sb2;
 407   sub mb2 {
 408     if (shift) {
 409       package bar;
 410       is mb2, 44, 'my sub visible inside itself after decl';
 411       is &mb2, 44, 'my sub visible inside itself after decl (amper)';
 412     }
 413     44
 414   }
 415   mb2(1);
 416   my sub mb3;
 417   {
 418     my sub mb3 { # new pad entry
 419       # The sub containing this comment is invisible inside itself.
 420       # So this one here will assign to the outer pad entry:
 421       sub mb3 { 47 }
 422     }
 423   }
 424   is eval{mb3}, 47,
 425     'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
 426   # Same test again, but inside an anonymous sub
 427   sub {
 428     my sub mb4;
 429     {
 430       my sub mb4 {
 431         sub mb4 { 47 }
 432       }
 433     }
 434     is mb4, 47,
 435       'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
 436   }->();
 437 }
 438 sub mc { 43 }
 439 {
 440   my sub mc;
 441   eval{mc};
 442   like $@, qr/^Undefined subroutine &mc called at /,
 443      'my sub foo; makes no lex alias for existing sub';
 444   eval{&mc};
 445   like $@, qr/^Undefined subroutine &mc called at /,
 446      'my sub foo; makes no lex alias for existing sub (amper)';
 447 }
 448 package main;
 449 {
 450   my sub me ($);
 451   is prototype eval{\&me}, '$', 'my sub with proto';
 452   is prototype "me", undef, 'prototype "..." ignores my subs';
 453
 454   my $coderef = eval "my sub foo (\$\x{30cd}) {1}; \\&foo";
 455   my $proto = prototype $coderef;
 456   ok(utf8::is_utf8($proto), "my sub with UTF8 proto maintains the UTF8ness");
 457   is($proto, "\$\x{30cd}", "check the prototypes actually match");
 458 }
 459 {
 460   my sub if() { 44 }
 461   my $x = if if if;
 462   is $x, 44, 'my subs override all keywords';
 463   package bar;
 464   my $y = if if if;
 465   is $y, 44, 'my subs from other packages override all keywords';
 466 }
 467 {
 468   use warnings; no warnings "experimental::lexical_subs";
 469   my $w ;
 470   local $SIG{__WARN__} = sub { $w .= shift };
 471   eval '#line 87 squidges
 472     my sub foo;
 473     my sub foo {};
 474   ';
 475   is $w,
 476      '"my" subroutine &foo masks earlier declaration in same scope at '
 477    . "squidges line 88.\n",
 478      'warning for my sub masking earlier declaration';
 479 }
 480 # Test that my subs are cloned inside anonymous subs.
 481 sub mmake_closure {
 482   my $x = shift;
 483   sub {
 484     my sub foo { $x }
 485     foo
 486   }
 487 }
 488 $sub1 = mmake_closure 48;
 489 $sub2 = mmake_closure 49;
 490 is &$sub1, 48, 'my sub in closure (1)';
 491 is &$sub2, 49, 'my sub in closure (2)';
 492 # Test that they are cloned in named subs.
 493 {
 494   use warnings; no warnings "experimental::lexical_subs";
 495   my $w;
 496   local $SIG{__WARN__} = sub { $w .= shift };
 497   eval '#line 65 teetet
 498     sub mfoom {
 499       my $x = shift;
 500       my sub poom { $x }
 501       \&poom
 502     }
 503   ';
 504   is $w, undef, 'my subs get no "Variable will not stay shared" messages';
 505   my $poom = mfoom(27);
 506   my $poom2 = mfoom(678);
 507   is $poom->(), 27, 'my subs closing over outer my var (1)';
 508   is $poom2->(), 678, 'my subs closing over outer my var (2)';
 509   my $x = 43;
 510   my sub aoeu;
 511   for $x (765) {
 512     my sub etetetet { $x }
 513     sub aoeu { $x }
 514     is etetetet, 765, 'my sub respects for() localisation';
 515     is aoeu, 43, 'unless it is declared outside the for loop';
 516   }
 517 }
 518 # And we also need to test that multiple my subs can close over each
 519 # other’s entries in the parent subs pad, and that cv_clone is not con-
 520 # fused by that.
 521 sub make_anon_with_my_sub{
 522   sub {
 523     my sub s1;
 524     my sub s2 { \&s1 }
 525     sub s1 { \&s2 }
 526     if (@_) { return eval { \&s1 } }
 527     is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub';
 528     is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub';
 529   }
 530 }
 531
 532 # Test my subs inside predeclared my subs
 533 {
 534   my sub s2;
 535   sub s2 {
 536     my $x = 3;
 537     my sub s3 { eval '$x' }
 538     s3;
 539   }
 540   is s2, 3, 'my sub inside predeclared my sub';
 541 }
 542
 543 {
 544   my $s = make_anon_with_my_sub;
 545   &$s;
 546
 547   # And make sure the my subs were actually cloned.
 548   isnt make_anon_with_my_sub->(0), &$s(0),
 549     'my subs in anon subs are cloned';
 550   isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub';
 551 }
 552 {
 553   my sub BEGIN { exit };
 554   pass 'my subs are never special blocks';
 555   my sub END { shift }
 556   is END('jkqeudth'), jkqeudth,
 557     'my sub END {shift} implies @_, not @ARGV';
 558 }
 559 {
 560   my sub redef {}
 561   use warnings; no warnings "experimental::lexical_subs";
 562   my $w;
 563   local $SIG{__WARN__} = sub { $w .= shift };
 564   eval "#line 56 pygpyf\nsub redef {}";
 565   is $w, "Subroutine redef redefined at pygpyf line 56.\n",
 566          "sub redefinition warnings from my subs";
 567
 568   undef $w;
 569   sub {
 570     my sub x {};
 571     sub { eval "#line 87 khaki\n\\&x" }
 572   }->()();
 573   is $w, "Subroutine \"&x\" is not available at khaki line 87.\n",
 574          "unavailability warning during compilation of eval in closure";
 575
 576   undef $w;
 577   no warnings 'void';
 578   eval <<'->()();';
 579 #line 87 khaki
 580     sub {
 581       my sub x{}
 582       sub not_lexical8 {
 583         \&x
 584       }
 585     }
 586 ->()();
 587   is $w, "Subroutine \"&x\" is not available at khaki line 90.\n",
 588          "unavailability warning during compilation of named sub in anon";
 589
 590   undef $w;
 591   sub not_lexical9 {
 592     my sub x {};
 593     format =
 594 @
 595 &x
 596 .
 597   }
 598   eval { write };
 599   my($f,$l) = (__FILE__,__LINE__ - 1);
 600   is $w, "Subroutine \"&x\" is not available at $f line $l.\n",
 601          'unavailability warning during cloning';
 602   $l -= 3;
 603   is $@, "Undefined subroutine &x called at $f line $l.\n",
 604          'Vivified sub is correctly named';
 605 }
 606 sub not_lexical10 {
 607   my sub foo;
 608   foo();
 609   sub not_lexical11 {
 610     my sub bar {
 611       my $x = 'khaki car keys for the khaki car';
 612       not_lexical10();
 613       sub foo {
 614        is $x, 'khaki car keys for the khaki car',
 615        'mysubs in inner clonables use the running clone of their CvOUTSIDE'
 616       }
 617     }
 618     bar()
 619   }
 620 }
 621 not_lexical11();
 622 {
 623   my sub p (\@) {
 624     is ref $_[0], 'ARRAY', 'my sub with proto';
 625   }
 626   p(my @a);
 627   p @a;
 628   my sub q () { 46 }
 629   is q(), 46, 'my constant called with parens';
 630 }
 631 {
 632   my sub x;
 633   my $count;
 634   sub x { x() if $count++ < 10 }
 635   x();
 636   is $count, 11, 'my recursive subs';
 637 }
 638 {
 639   my sub x;
 640   eval 'sub x {3}';
 641   is x, 3, 'my sub defined inside eval';
 642 }
 643
 644 {
 645   state $w;
 646   local $SIG{__WARN__} = sub { $w .= shift };
 647   eval q{ my sub george () { 2 } };
 648   is $w, undef, 'no double free from constant my subs';
 649 }
 650 like runperl(
 651       switches => [ '-Mfeature=lexical_subs,state' ],
 652       prog     => 'my sub a { foo ref } a()',
 653       stderr   => 1
 654      ),
 655      qr/syntax error/,
 656     'referencing a my sub after a syntax error does not crash';
 657 {
 658   state $stuff;
 659   package A {
 660     my sub foo{ $stuff .= our $AUTOLOAD }
 661     *A::AUTOLOAD = \&foo;
 662   }
 663   A::bar();
 664   is $stuff, 'A::bar', 'my sub assigned to *AUTOLOAD can autoload';
 665 }
 666 {
 667   my sub quire{qr "quires"}
 668   package mo { use overload qr => \&quire }
 669   ok "quires" =~ bless([], mo::), 'my sub used as overload method';
 670 }
 671 {
 672   my sub foo;
 673   *mcvgv = \&foo;
 674   local *mcvgv2 = *mcvgv;
 675   eval 'sub mcvgv2 {42}'; # uses the stub already present
 676   is foo, 42, 'defining my sub body via package sub declaration';
 677 }
 678 {
 679   my sub foo;
 680   *mcvgv3 = \&foo;
 681   local *mcvgv4 = *mcvgv3;
 682   eval 'sub mcvgv4 {42}'; # uses the stub already present
 683   undef *mcvgv3; undef *mcvgv4; # leaves the pad with the only reference
 684 }
 685 # We would have crashed by now if it weren’t fixed.
 686 pass "pad taking ownership once more of packagified my-sub";
 687
 688 {
 689   local $ENV{PERL5DB} = 'sub DB::DB{}';
 690   is(
 691     runperl(
 692      switches => [ '-d' ],
 693      progs => [ split "\n",
 694       'use feature qw - lexical_subs state -;
 695        no warnings q-experimental::lexical_subs-;
 696        sub DB::sub{ print qq|4\n|; goto $DB::sub }
 697        my sub foo {print qq|2\n|}
 698        foo();
 699       '
 700      ],
 701      stderr => 1
 702     ),
 703     "4\n2\n",
 704     'my subs and DB::sub under -d'
 705   );
 706 }
 707
 708 # -------------------- Interactions (and misc tests) -------------------- #
 709
 710 is sub {
 711     my sub s1;
 712     my sub s2 { 3 };
 713     sub s1 { state sub foo { \&s2 } foo }
 714     s1
 715   }->()(), 3, 'state sub inside my sub closing over my sub uncle';
 716
 717 {
 718   my sub s2 { 3 };
 719   sub not_lexical { state sub foo { \&s2 } foo }
 720   is not_lexical->(), 3, 'state subs that reference my sub from outside';
 721 }
 722
 723 # Test my subs inside predeclared package subs
 724 # This test also checks that CvOUTSIDE pointers are not mangled when the
 725 # inner sub’s CvOUTSIDE points to another sub.
 726 sub not_lexical2;
 727 sub not_lexical2 {
 728   my $x = 23;
 729   my sub bar;
 730   sub not_lexical3 {
 731     not_lexical2();
 732     sub bar { $x }
 733   };
 734   bar
 735 }
 736 is not_lexical3, 23, 'my subs inside predeclared package subs';
 737
 738 # Test my subs inside predeclared package sub, where the lexical sub is
 739 # declared outside the package sub.
 740 # This checks that CvOUTSIDE pointers are fixed up even when the sub is
 741 # not declared inside the sub that its CvOUTSIDE points to.
 742 sub not_lexical5 {
 743   my sub foo;
 744   sub not_lexical4;
 745   sub not_lexical4 {
 746     my $x = 234;
 747     not_lexical5();
 748     sub foo { $x }
 749   }
 750   foo
 751 }
 752 is not_lexical4, 234,
 753     'my sub defined in predeclared pkg sub but declared outside';
 754
 755 undef *not_lexical6;
 756 {
 757   my sub foo;
 758   sub not_lexical6 { sub foo { } }
 759   pass 'no crash when cloning a mysub declared inside an undef pack sub';
 760 }
 761
 762 undef &not_lexical7;
 763 eval 'sub not_lexical7 { my @x }';
 764 {
 765   my sub foo;
 766   foo();
 767   sub not_lexical7 {
 768     state $x;
 769     sub foo {
 770       is ref \$x, 'SCALAR',
 771         "redeffing a mysub's outside does not make it use the wrong pad"
 772     }
 773   }
 774 }
 775
 776 like runperl(
 777       switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
 778       prog     => 'my sub foo; sub foo { foo } foo',
 779       stderr   => 1
 780      ),
 781      qr/Deep recursion on subroutine "foo"/,
 782     'deep recursion warnings for lexical subs do not crash';
 783
 784 like runperl(
 785       switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
 786       prog     => 'my sub foo() { 42 } undef &foo',
 787       stderr   => 1
 788      ),
 789      qr/Constant subroutine foo undefined at /,
 790     'constant undefinition warnings for lexical subs do not crash';
 791
 792 {
 793   my sub foo;
 794   *AutoloadTestSuper::blah = \&foo;
 795   sub AutoloadTestSuper::AUTOLOAD {
 796     is $AutoloadTestSuper::AUTOLOAD, "AutoloadTestSuper::blah",
 797       "Autoloading via inherited lex stub";
 798   }
 799   @AutoloadTest::ISA = AutoloadTestSuper::;
 800   AutoloadTest->blah;
 801 }