anonconst.t for testing :const

2 files changed, 41 insertions, 0 deletions

diff --git a/MANIFEST b/MANIFEST
index 65ead36921..22a0d209e1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5227,6 +5227,7 @@ t/mro/vulcan_dfs_utf8.t		utf8 mro tests
 toke.c				The tokener
 t/op/64bitint.t			See if 64 bit integers work
 t/op/alarm.t			See if alarm works
+t/op/anonconst.t		See if :const works
 t/op/anonsub.t			See if anonymous subroutines work
 t/op/append.t			See if . works
 t/op/args.t			See if operations on @_ work
diff --git a/t/op/anonconst.t b/t/op/anonconst.t
new file mode 100644
index 0000000000..cd48ebbbf2
--- /dev/null
+++ b/t/op/anonconst.t
@@ -0,0 +1,40 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    require './test.pl';
+}
+
+plan 7;
+
+push @subs, sub :const{$_} for 1..10;
+is join(" ", map &$_, @subs), "1 2 3 4 5 6 7 8 9 10",
+  ':const capturing global $_';
+
+my $x = 3;
+my $sub = sub : const { $x };
+$x++;
+is &$sub, 3, ':const capturing lexical';
+
+$x = 3;
+$sub = sub : const { $x+5 };
+$x++;
+is &$sub, 8, ':const capturing expression';
+
+is &{sub () : const { 42 }}, 42, ':const with truly constant sub';
+
+*foo = $sub;
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w .= shift };
+    *foo = sub (){};
+    like $w, qr/^Constant subroutine main::foo redefined at /,
+        ':const subs are constant';
+}
+
+eval 'sub bar : const';
+like $@, qr/^:const is not permitted on named subroutines at /,
+    ':const on named stub';
+eval 'sub baz : const { }';
+like $@, qr/^:const is not permitted on named subroutines at /,
+    ':const on named sub';