import experimental.pm

5 files changed, 199 insertions, 0 deletions

diff --git a/MANIFEST b/MANIFEST
index 9652cd513a..ea0065d2ec 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -972,6 +972,8 @@ cpan/encoding-warnings/t/1-warning.t	tests for encoding::warnings
 cpan/encoding-warnings/t/2-fatal.t	tests for encoding::warnings
 cpan/encoding-warnings/t/3-normal.t	tests for encoding::warnings
 cpan/encoding-warnings/t/4-lexical.t	tests for encoding::warnings
+cpan/experimental/lib/experimental.pm
+cpan/experimental/t/basic.t
 cpan/ExtUtils-Constant/lib/ExtUtils/Constant/Base.pm		generate XS code to import C header constants
 cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm			generate XS code to import C header constants
 cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm	generate XS code for proxy constants
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index fe2f5312a5..475a40649e 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -407,6 +407,15 @@ use File::Glob qw(:case);
         'EXCLUDED'     => [qr{^t/release-.*\.t}],
     },
 
+    'experimental' => {
+        'DISTRIBUTION' => 'LEONT/experimental-0.007.tar.gz',
+        'FILES'        => q[cpan/experimental],
+        'EXCLUDED'     => [
+          qr{^t/release-.*\.t},
+          't/00-compile.t',
+        ],
+    },
+
     'Exporter' => {
         'DISTRIBUTION' => 'TODDR/Exporter-5.68.tar.gz',
         'FILES'        => q[dist/Exporter],
diff --git a/cpan/experimental/lib/experimental.pm b/cpan/experimental/lib/experimental.pm
new file mode 100644
index 0000000000..1c43e1064a
--- /dev/null
+++ b/cpan/experimental/lib/experimental.pm
@@ -0,0 +1,151 @@
+package experimental;
+$experimental::VERSION = '0.007';
+use strict;
+use warnings;
+
+use feature ();
+use Carp qw/croak carp/;
+
+my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets;
+my %features = map { $_ => 1 } keys %feature::feature;
+
+my %min_version = (
+	array_base    => 5,
+	autoderef     => 5.014000,
+	lexical_topic => 5.010000,
+	regex_sets    => 5.018000,
+	smartmatch    => 5.010001,
+	signatures    => 5.019009, # change to 5.20.0 someday? -- rjbs, 2014-02-08
+);
+
+my %additional = (
+	postderef  => ['postderef_qq'],
+	switch     => ['smartmatch'],
+);
+
+sub _enable {
+	my $pragma = shift;
+	if ($warnings{"experimental::$pragma"}) {
+		warnings->unimport("experimental::$pragma");
+		feature->import($pragma) if exists $features{$pragma};
+		_enable(@{ $additional{$pragma} }) if $additional{$pragma};
+	}
+	elsif ($features{$pragma}) {
+		feature->import($pragma);
+		_enable(@{ $additional{$pragma} }) if $additional{$pragma};
+	}
+	elsif (not exists $min_version{$pragma}) {
+		croak "Can't enable unknown feature $pragma";
+	}
+	elsif ($min_version{$pragma} > $]) {
+		croak "Need perl version $min_version{$pragma} or later for feature $pragma";
+	}
+}
+
+sub import {
+	my ($self, @pragmas) = @_;
+
+	for my $pragma (@pragmas) {
+		_enable($pragma);
+	}
+	return;
+}
+
+sub _disable {
+	my $pragma = shift;
+	if ($warnings{"experimental::$pragma"}) {
+		warnings->import("experimental::$pragma");
+		feature->unimport($pragma) if exists $features{$pragma};
+		_disable(@{ $additional{$pragma} }) if $additional{$pragma};
+	}
+	elsif ($features{$pragma}) {
+		feature->unimport($pragma);
+		_disable(@{ $additional{$pragma} }) if $additional{$pragma};
+	}
+	elsif (not exists $min_version{$pragma}) {
+		carp "Can't disable unknown feature $pragma, ignoring";
+	}
+}
+
+sub unimport {
+	my ($self, @pragmas) = @_;
+
+	for my $pragma (@pragmas) {
+		_disable($pragma);
+	}
+	return;
+}
+
+1;
+
+#ABSTRACT: Experimental features made easy
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+experimental - Experimental features made easy
+
+=head1 VERSION
+
+version 0.007
+
+=head1 SYNOPSIS
+
+ use experimental 'lexical_subs', 'smartmatch';
+ my sub foo { $_[0] ~~ 1 }
+
+=head1 DESCRIPTION
+
+This pragma provides an easy and convenient way to enable or disable
+experimental features.
+
+Every version of perl has some number of features present but considered
+"experimental."  For much of the life of Perl 5, this was only a designation
+found in the documentation.  Starting in Perl v5.10.0, and more aggressively in
+v5.18.0, experimental features were placed behind pragmata used to enable the
+feature and disable associated warnings.
+
+The C<experimental> pragma exists to combine the required incantations into a
+single interface stable across releases of perl.  For every experimental
+feature, this should enable the feature and silence warnings for the enclosing
+lexical scope:
+
+  use experimental 'feature-name';
+
+To disable the feature and, if applicable, re-enable any warnings, use:
+
+  no experimental 'feature-name';
+
+The supported features, documented further below, are:
+
+	array_base    - allow the use of $[ to change the starting index of @array
+	autoderef     - allow push, each, keys, and other built-ins on references
+	lexical_topic - allow the use of lexical $_ via "my $_"
+	postderef     - allow the use of postfix dereferencing expressions, including
+	                in interpolating strings
+	regex_sets    - allow extended bracketed character classes in regexps
+	signatures    - allow subroutine signatures (for named arguments)
+	smartmatch    - allow the use of ~~, given, and when
+
+=head2 Disclaimer
+
+Because of the nature of the features it enables, forward compatibility can not
+be guaranteed in any way.
+
+=head1 AUTHOR
+
+Leon Timmermans <leont@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2013 by Leon Timmermans.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
diff --git a/cpan/experimental/t/basic.t b/cpan/experimental/t/basic.t
new file mode 100644
index 0000000000..bb1ed81866
--- /dev/null
+++ b/cpan/experimental/t/basic.t
@@ -0,0 +1,36 @@
+#! perl
+
+use Test::More 0.89;
+
+local $SIG{__WARN__} = sub { fail("Got unexpected warning"); diag($_[0]) };
+
+if ($] >= 5.010000) {
+	is (eval <<'END', 1, 'lexical topic compiles') or diag $@;
+	use experimental 'lexical_topic';
+	my $_ = 1;
+	is($_, 1, '$_ is 1');
+END
+}
+else {
+	fail("No experimental features available on perl $]");
+}
+
+if ($] >= 5.010001) {
+	is (eval <<'END', 1, 'smartmatch compiles') or diag $@;
+	use experimental 'smartmatch';
+	sub bar { 1 };
+	is(1 ~~ \&bar, 1, "is 1");
+END
+}
+
+if ($] >= 5.018) {
+	is (eval <<'END', 1, 'lexical subs compiles') or diag $@;
+	use experimental 'lexical_subs';
+	my sub foo { 1 };
+	is(foo(), 1, "foo is 1");
+	1;
+END
+}
+
+done_testing;
+
diff --git a/lib/.gitignore b/lib/.gitignore
index 547c5e8814..8848333643 100644
--- a/lib/.gitignore
+++ b/lib/.gitignore
@@ -200,6 +200,7 @@
 /constant.pm
 /encoding.pm
 /encoding/
+/experimental.pm
 /fields.pm
 /if.pm
 /inc/