add new dot feature (-> is now ., . is now ~)
authorLeon Brocard <acme@astray.com>
Wed, 2 Nov 2011 08:05:55 +0000 (08:05 +0000)
committerLeon Brocard <acme@astray.com>
Wed, 2 Nov 2011 08:05:55 +0000 (08:05 +0000)
use feature 'dot' tells the compiler to accept . everywhere it would
normally accept -> and to accept ~ as concatenation.

MANIFEST
lib/feature.pm
pod/perldelta.pod
t/lib/feature/dot [new file with mode: 0644]
toke.c

index 19eab08..c397c4e 100644 (file)
--- 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
index 78cb8fc..7d577d3 100644 (file)
@@ -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
index ceda45a..a791b52 100644 (file)
@@ -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 (file)
index 0000000..3e86cc6
--- /dev/null
@@ -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 aaeff85..42c8119 100644 (file)
--- 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':