add new dot feature (-> is now ., . is now ~)

use feature 'dot' tells the compiler to accept . everywhere it would
normally accept -> and to accept ~ as concatenation.

5 files changed, 95 insertions, 4 deletions

diff --git a/MANIFEST b/MANIFEST
index 19eab085b9..c397c4eb72 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4913,6 +4913,7 @@ t/lib/deprecate.t		Test deprecate.pm
 t/lib/Devel/switchd_empty.pm	Module for t/run/switchd.t
 t/lib/Devel/switchd.pm		Module for t/run/switchd.t
 t/lib/feature/bundle		Tests for feature bundles
+t/lib/feature/dot		Tests for the dot feature
 t/lib/feature/implicit		Tests for implicit loading of feature.pm
 t/lib/feature/nonesuch		Tests for enabling/disabling nonexistent feature
 t/lib/feature/say		Tests for enabling/disabling say feature
diff --git a/lib/feature.pm b/lib/feature.pm
index 78cb8fcd28..7d577d36a9 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -1,6 +1,6 @@
 package feature;
 
-our $VERSION = '1.22';
+our $VERSION = '1.23';
 
 # (feature name) => (internal name, used in %^H)
 my %feature = (
@@ -8,6 +8,7 @@ my %feature = (
     state           => 'feature_state',
     switch          => 'feature_switch',
     unicode_strings => 'feature_unicode',
+    dot             => 'feature_dot',
 );
 
 # This gets set (for now) in $^H as well as in %^H,
@@ -126,6 +127,11 @@ C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
 This subpragma is available starting with Perl 5.11.3, but was not fully
 implemented until 5.13.8.
 
+=head2 the 'dot' feature
+
+C<use feature 'dot'> tells the compiler to accept . everywhere it would
+normally accept -> and to accept ~ as concatenation.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load a whole slew of features in one go, using
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index ceda45a71b..a791b5215a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -40,6 +40,11 @@ XXX That last sentence is not true yet.
 
 The new implementation has some bug fixes.  See L<arybase>.
 
+=head2 new dot feature
+
+C<use feature 'dot'> tells the compiler to accept . everywhere it would
+normally accept -> and to accept ~ as concatenation.
+
 =head1 Security
 
 XXX Any security-related notices go here.  In particular, any security
diff --git a/t/lib/feature/dot b/t/lib/feature/dot
new file mode 100644
index 0000000000..3e86cc6526
--- /dev/null
+++ b/t/lib/feature/dot
@@ -0,0 +1,66 @@
+Check feature bundles.
+
+__END__
+# Test dot without feature
+use feature qw(say);
+say "Hello" . "world";
+EXPECT
+Helloworld
+########
+# Test ~ with feature
+use feature qw(say dot);
+say "Hello" ~ "world";
+EXPECT
+Helloworld
+########
+# Test -> for method calls without feature
+use feature qw(say);
+use CGI;
+my $q = CGI->new;
+say ref($q);
+say $q->blockquote(
+  "Many years ago on the island of",
+  $q->a({href=>"http://crete.org/"},"Crete"),
+  "there lived a Minotaur named",
+  $q->strong("Fred."),
+),
+$q->hr;
+EXPECT
+CGI
+<blockquote>Many years ago on the island of <a href="http://crete.org/">Crete</a> there lived a Minotaur named <strong>Fred.</strong></blockquote><hr />
+########
+# Test . for method calls with feature
+use feature qw(say dot);
+use CGI;
+my $q = CGI.new;
+say ref($q);
+say $q.blockquote(
+  "Many years ago on the island of",
+  $q.a({href=>"http://crete.org/"},"Crete"),
+  "there lived a Minotaur named",
+  $q.strong("Fred.") ,
+),
+$q.hr;
+EXPECT
+CGI
+<blockquote>Many years ago on the island of <a href="http://crete.org/">Crete</a> there lived a Minotaur named <strong>Fred.</strong></blockquote><hr />
+########
+# Test -> for array/hash dereference without feature
+use feature qw(say);
+my $arrayref = [1,2,3,4,5];
+say $arrayref->[-1];
+my $hashref = {a => 1, b => 2};
+say $hashref->{b};
+EXPECT
+5
+2
+########
+# Test . for array/hash dereference with feature
+use feature qw(say dot);
+my $arrayref = [1,2,3,4,5];
+say $arrayref.[-1];
+my $hashref = {a => 1, b => 2};
+say $hashref.{b};
+EXPECT
+5
+2
diff --git a/toke.c b/toke.c
index aaeff85a27..42c8119def 100644
--- a/toke.c
+++ b/toke.c
@@ -690,7 +690,6 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
 	Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start");
 
     /* create and initialise a parser */
-
     Newxz(parser, 1, yy_parser);
     parser->old_parser = oparser = PL_parser;
     PL_parser = parser;
@@ -5325,7 +5324,14 @@ Perl_yylex(pTHX)
 	    Eop(OP_SMARTMATCH);
 	}
 	s++;
-	OPERATOR('~');
+	if (Perl_feature_is_enabled(aTHX_ "dot", 3)) {
+	    /* Perl_warn("feature dot enabled, ~ becomes concat\n"); */
+	    Aop(OP_CONCAT);
+	} else {
+	    /* Perl_warn("feature dot not enabled, ~ stays ~\n"); */
+	    OPERATOR('~');
+	}
+
     case ',':
 	if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
 	    TOKEN(0);
@@ -6263,7 +6269,14 @@ Perl_yylex(pTHX)
 		s--;
 		TOKEN(0);
 	    }
-	    Aop(OP_CONCAT);
+	    if (Perl_feature_is_enabled(aTHX_ "dot", 3)) {
+		/* Perl_warn("feature dot enabled, . becomes ->\n"); */
+		s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+		TOKEN(ARROW);
+	    } else {
+		/* Perl_warn("feature dot not enabled, . stays .\n"); */
+		Aop(OP_CONCAT);
+	    }
 	}
 	/* FALL THROUGH */
     case '0': case '1': case '2': case '3': case '4':