From 0c1fbeee151a8f54be7bad1c6e55ac4f4f3931a5 Mon Sep 17 00:00:00 2001 From: Leon Brocard Date: Wed, 2 Nov 2011 08:05:55 +0000 Subject: [PATCH] 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. --- MANIFEST | 1 + lib/feature.pm | 8 +++++- pod/perldelta.pod | 5 ++++ t/lib/feature/dot | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++ toke.c | 19 +++++++++++++-- 5 files changed, 95 insertions(+), 4 deletions(-) create mode 100644 t/lib/feature/dot diff --git a/MANIFEST b/MANIFEST index 19eab08..c397c4e 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 78cb8fc..7d577d3 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 subpragma is B 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 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 ceda45a..a791b52 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. +=head2 new dot feature + +C 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 0000000..3e86cc6 --- /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 +
Many years ago on the island of Crete there lived a Minotaur named Fred.
+######## +# 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 +
Many years ago on the island of Crete there lived a Minotaur named Fred.
+######## +# 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 --- 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': -- 1.7.4.1