Test state subs

Most of these tests are still to-do.  The previous commit got every-
thing compiling at least.  Then I went through putting eval{} around
all the dying tests and marking the failing tests as to-do.

At least this way I don’t have to do everything at once (even though
that was how I wrote the tests).

About the only thing that works is constant inlining, of all things.

1 files changed, 188 insertions, 1 deletions

diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t
index 328b410464..be9f5637f2 100644
--- a/t/cmd/lexsub.t
+++ b/t/cmd/lexsub.t
@@ -5,9 +5,12 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
     *bar::is = *is;
+    *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 22;
+plan 58;
+
+# -------------------- our -------------------- #
 
 {
   our sub foo { 42 }
@@ -78,3 +81,187 @@ sub bar::c { 43 }
   my $y = if if if;
   is $y, 42, 'our subs from other packages override all keywords';
 }
+
+# -------------------- state -------------------- #
+
+sub on { $::TODO = ' ' }
+sub off { $::TODO = undef }
+
+use 5.01; # state
+{
+  state sub foo { 44 }
+  isnt \&::foo, eval {\&foo}, 'state sub is not stored in the package';
+on;
+  is eval{foo}, 44, 'calling state sub from same package';
+  is eval{&foo}, 44, 'calling state sub from same package (amper)';
+  is eval{do foo()}, 44, 'calling state sub from same package (do)';
+  package bar;
+  is eval{foo}, 44, 'calling state sub from another package';
+  is eval{&foo}, 44, 'calling state sub from another package (amper)';
+  is eval{do foo()}, 44, 'calling state sub from another package (do)';
+}
+off;
+package bar;
+is foo, 43, 'state sub falling out of scope';
+is &foo, 43, 'state sub falling out of scope (called via amper)';
+is do foo(), 43, 'state sub falling out of scope (called via amper)';
+{
+  sub sa { 43 }
+  state sub sa {
+    if (shift) {
+      is sa, 43, 'state sub invisible inside itself';
+      is &sa, 43, 'state sub invisible inside itself (called via amper)';
+      is do sa(), 43, 'state sub invisible inside itself (called via do)';
+    }
+    44
+  }
+SKIP: { ::skip "Tests are inside a state sub (still uncallable)", 3;
+  sa(1);
+}
+  sub sb { 43 }
+  state sub sb;
+  state sub sb {
+    if (shift) {
+      # ‘state sub foo{}’ creates a new pad entry, not reusing the forward
+      #  declaration.  Being invisible inside itself, it sees the stub.
+      eval{sb};
+      like $@, qr/^Undefined subroutine &sb called at /,
+        'state sub foo {} after forward declaration';
+      eval{&sb};
+      like $@, qr/^Undefined subroutine &sb called at /,
+        'state sub foo {} after forward declaration (amper)';
+      eval{do sb()};
+      like $@, qr/^Undefined subroutine &sb called at /,
+        'state sub foo {} after forward declaration (do)';
+    }
+    44
+  }
+SKIP: { ::skip "Tests are inside a state sub (still uncallable)", 3;
+  sb(1);
+}
+  sub sb2 { 43 }
+  state sub sb2;
+  sub sb2 {
+    if (shift) {
+      package bar;
+      is b, 44, 'state sub visible inside itself after decl';
+      is &b, 44, 'state sub visible inside itself after decl (amper)';
+      is do b(), 44, 'state sub visible inside itself after decl (do)';
+    }
+    44
+  }
+SKIP: { ::skip "Tests are inside a state sub (still uncallable)", 3;
+  sb2(1);
+}
+  state sub sb3;
+  {
+    state sub sb3 { # new pad entry
+      # The sub containing this comment is invisible inside itself.
+      # So this one here will assign to the outer pad entry:
+      sub sb3 { 47 }
+    }
+  }
+::on;
+  is eval{sb3}, 47,
+    'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
+}
+sub sc { 43 }
+{
+  state sub sc;
+  eval{sc};
+  like $@, qr/^Undefined subroutine &sb called at /,
+     'state sub foo; makes no lex alias for existing sub';
+  eval{&sc};
+  like $@, qr/^Undefined subroutine &sb called at /,
+     'state sub foo; makes no lex alias for existing sub (amper)';
+  eval{do sc()};
+  like $@, qr/^Undefined subroutine &sb called at /,
+     'state sub foo; makes no lex alias for existing sub (do)';
+}
+package main;
+{
+  state sub se ($);
+  is prototype eval{\&se}, '$', 'state sub with proto';
+off;
+  is prototype "se", undef, 'prototype "..." ignores state subs';
+}
+{
+  state sub if() { 44 }
+  my $x = if if if;
+  is $x, 44, 'state subs override all keywords';
+  package bar;
+  my $y = if if if;
+  is $y, 44, 'state subs from other packages override all keywords';
+}
+{
+  use warnings;
+  state $w ;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval '#line 87 squidges
+    state sub foo;
+    state sub foo {};
+  ';
+on;
+  is $w,
+     '"state" subroutine foo masks earlier declaration in same scope at '
+   . "squidges line 88.\n",
+     'redefinition warning for state sub';
+}
+# Since state vars inside anonymous subs are cloned at the same time as the
+# anonymous subs containing them, the same should happen for state subs.
+sub make_closure {
+  state $x = shift;
+  sub {
+    state sub foo { $x }
+    eval {foo}
+  }
+}
+$sub1 = make_closure 48;
+$sub2 = make_closure 49;
+is &$sub1, 48, 'state sub in closure (1)';
+is &$sub1, 49, 'state sub in closure (2)';
+off;
+# But we need to test that state subs actually do persist from one invoca-
+# tion of a named sub to another (i.e., that they are not my subs).
+{
+  use warnings;
+  state $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval '#line 65 teetet
+    sub foom {
+      my $x = shift;
+      state sub poom { $x }
+      eval{\&poom}
+    }
+  ';
+  is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
+         'state subs get "Variable will not stay shared" messages';
+  my $poom = foom(27);
+  my $poom2 = foom(678);
+  is eval{$poom->()}, eval {$poom2->()},
+    'state subs close over the first outer my var, like pkg subs';
+  my $x = 43;
+  for $x (765) {
+    state sub etetetet { $x }
+on;
+    is eval{etetetet}, $x, 'state sub ignores for() localisation';
+off;
+  }
+}
+{
+  state sub BEGIN { exit };
+  pass 'state subs are never special blocks';
+  state sub END { shift }
+on;
+  is eval{END('jkqeudth')}, jkqeudth,
+    'state sub END {shift} implies @_, not @ARGV';
+}
+{
+  state sub redef {}
+  use warnings;
+  state $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval "#line 56 pygpyf\nsub redef {}";
+  is $w, "Subroutine redef redefined at pygpyf line 56.\n",
+         "sub redefinition warnings from state subs";
+}