In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/da9ca395ced485afc455e876f420809dc0e64544?hp=6324db4a7acbde8f32471c0cc702298254623440>
- Log ----------------------------------------------------------------- commit da9ca395ced485afc455e876f420809dc0e64544 Author: Father Chrysostomos <[email protected]> Date: Tue Dec 2 14:10:58 2014 -0800 Add James Raspass to AUTHORS M AUTHORS commit cf95e7c298dd692c258ac6d354018a5b36fe0a14 Author: Father Chrysostomos <[email protected]> Date: Tue Dec 2 14:10:27 2014 -0800 Increase $strict::VERSION to 1.09 M lib/strict.pm commit ed958fa3156084f3cf4d8c4768716d9e1a11ce91 Author: James Raspass <[email protected]> Date: Tue Dec 2 13:41:19 2014 -0800 Optimise strict.pm for the common case M lib/strict.pm M lib/strict.t commit 3d6de2cd13dfe0ce6162563bc69ff8f6329e8664 Author: Father Chrysostomos <[email protected]> Date: Tue Dec 2 05:48:33 2014 -0800 pad.h: Use PERL_PADNAME_MINIMAL by default See <cacmk_tvktetxz2efc-bjfxehwrjaexuvv4zw4z036ojhpwf...@mail.gmail.com> and <[email protected]>. M pad.h commit f1602e0aeea446456c6f795f1844004479db4de3 Author: Father Chrysostomos <[email protected]> Date: Tue Dec 2 05:35:08 2014 -0800 perl5220delta: Want 0.24 has been released M Porting/perl5220delta.pod commit 429ba3b2012d512799f9533216081e1375fad0cb Author: Father Chrysostomos <[email protected]> Date: Mon Dec 1 22:26:33 2014 -0800 Add B::PMOP::pmregexp There was no way to get from a PMOP to its regexp object under non- threaded builds. The threaded pmoffset field was exposed, but not its non-threaded counterpart. I implemented pmregexp in terms of PM_GETRE (which uses op_pmoffset with threads and op_pmregexp without), so it works under threads, too. Itâs easier than conditionally using the regex_padav to get at things like this: $ ./perl -Ilib -MB -e 'use O "Concise", B::regex_padav->ARRAYelt(B::svref_2object(sub {qr/(??{})/})->ROOT->first->first->sibling->pmoffset)->qr_anoncv->object_2svref' B::Concise::compile(CODE(0x7f8e9185ba08)) 2 <1> leavesub[1 ref] K/REFC,1 ->(end) 1 </> qr() P/RTIME ->2 - <@> list K ->- - <0> pushmark s ->- - <1> null sK*/1 ->- - <1> ex-scope sK ->(end) - <0> stub s ->(end) - <$> const(PV "(\077?{})") s ->- -e syntax OK With pmregexp, it is âonlyâ: $ ./perl -Ilib -MB -e 'use O "Concise", B::svref_2object(sub {qr/(??{})/})->ROOT->first->first->sibling->pmregexp->qr_anoncv->object_2svref' M ext/B/B.pm M ext/B/B.xs M ext/B/t/b.t commit 4a31a50691fe6d239cc60d9cce54883f1bfb1214 Author: Father Chrysostomos <[email protected]> Date: Mon Dec 1 22:08:49 2014 -0800 b.t: Move a test This should go with the other regexp tests. M ext/B/t/b.t ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + Porting/perl5220delta.pod | 4 --- ext/B/B.pm | 7 +++++ ext/B/B.xs | 5 ++++ ext/B/t/b.t | 8 ++++-- lib/strict.pm | 65 ++++++++++++++++++++++++++++++++--------------- lib/strict.t | 10 +++++++- pad.h | 2 +- 8 files changed, 74 insertions(+), 28 deletions(-) diff --git a/AUTHORS b/AUTHORS index e6ad335..7f86e61 100644 --- a/AUTHORS +++ b/AUTHORS @@ -520,6 +520,7 @@ James FitzGibbon <[email protected]> James Jurach <[email protected]> James E Keenan <[email protected]> James Mastros <[email protected]> +James Raspass <[email protected]> Jamshid Afshar Jan D. <[email protected]> Jan Dubois <[email protected]> diff --git a/Porting/perl5220delta.pod b/Porting/perl5220delta.pod index de5af16..603d4f9 100644 --- a/Porting/perl5220delta.pod +++ b/Porting/perl5220delta.pod @@ -395,10 +395,6 @@ L<Padre> version 1.00 L<Parse::Keyword> 0.08 -=item * - -L<Want> 0.23 - =back =back diff --git a/ext/B/B.pm b/ext/B/B.pm index 038d83c..4dffea1 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -1218,6 +1218,13 @@ Only when perl was compiled with ithreads. Since perl 5.17.1 +=item pmregexp + +Added in perl 5.22, this method returns the B::REGEXP associated with the +op. While PMOPs do not actually have C<pmregexp> fields under threaded +builds, this method returns the regexp under threads nonetheless, for +convenience. + =back =head2 B::SVOP METHOD diff --git a/ext/B/B.xs b/ext/B/B.xs index 86bd09c..d08750c 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -750,6 +750,7 @@ struct OP_methods { #if PERL_VERSION >= 21 { STR_WITH_LEN("first"), op_offset_special, 0, },/*53*/ { STR_WITH_LEN("meth_sv"), op_offset_special, 0, },/*54*/ + { STR_WITH_LEN("pmregexp"),op_offset_special, 0, },/*55*/ #endif }; @@ -1030,6 +1031,7 @@ next(o) B::OP::parent = 52 B::METHOP::first = 53 B::METHOP::meth_sv = 54 + B::PMOP::pmregexp = 55 PREINIT: SV *ret; PPCODE: @@ -1245,6 +1247,9 @@ next(o) o->op_type == OP_METHOD ? NULL : cMETHOPx(o)->op_u.op_meth_sv); break; + case 55: /* B::PMOP::pmregexp */ + ret = make_sv_object(aTHX_ (SV *)PM_GETRE(cPMOPo)); + break; default: croak("method %s not implemented", op_methods[ix].name); } else { diff --git a/ext/B/t/b.t b/ext/B/t/b.t index 544ba08..abffa32 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -108,6 +108,8 @@ my $obj = B::svref_2object($r); my $regexp = ($] < 5.011) ? $obj->MAGIC : $obj; ok($regexp->precomp() eq 'foo', 'Get string from qr//'); like($regexp->REGEX(), qr/\d+/, "REGEX() returns numeric value"); +is B::svref_2object(qr/(?{time})/)->qr_anoncv->ROOT->first->name, 'qr', + 'qr_anoncv'; my $iv = 1; my $iv_ref = B::svref_2object(\$iv); is(ref $iv_ref, "B::IV", "Test B:IV return from svref_2object"); @@ -338,8 +340,10 @@ SKIP: { 'different COP->stashoff for different stashes'; } -is B::svref_2object(qr/(?{time})/)->qr_anoncv->ROOT->first->name, 'qr', - 'qr_anoncv'; +my $pmop = B::svref_2object(sub{ qr/fit/ })->ROOT->first->first->sibling; +$regexp = $pmop->pmregexp; +is B::class($regexp), 'REGEXP', 'B::PMOP::pmregexp returns a regexp'; +is $regexp->precomp, 'fit', 'pmregexp returns the right regexp'; # Test $B::overlay diff --git a/lib/strict.pm b/lib/strict.pm index 8eed8bc..03ed21c 100644 --- a/lib/strict.pm +++ b/lib/strict.pm @@ -1,6 +1,6 @@ package strict; -$strict::VERSION = "1.08"; +$strict::VERSION = "1.09"; # Verify that we're called correctly so that strictures will work. unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { @@ -9,26 +9,46 @@ unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n"); } -my %bitmask = ( -refs => 0x00000002, -subs => 0x00000200, -vars => 0x00000400 -); -my %explicit_bitmask = ( -refs => 0x00000020, -subs => 0x00000040, -vars => 0x00000080 -); +my ( %bitmask, %explicit_bitmask ); + +BEGIN { + %bitmask = ( + refs => 0x00000002, + subs => 0x00000200, + vars => 0x00000400, + ); + + %explicit_bitmask = ( + refs => 0x00000020, + subs => 0x00000040, + vars => 0x00000080, + ); + + my $bits = 0; + $bits |= $_ for values %bitmask; + + my $inline_all_bits = $bits; + *all_bits = sub () { $inline_all_bits }; + + $bits = 0; + $bits |= $_ for values %explicit_bitmask; + + my $inline_all_explicit_bits = $bits; + *all_explicit_bits = sub () { $inline_all_explicit_bits }; +} sub bits { my $bits = 0; my @wrong; foreach my $s (@_) { - if (exists $bitmask{$s}) { - $^H |= $explicit_bitmask{$s}; - } - else { push @wrong, $s }; - $bits |= $bitmask{$s} || 0; + if (exists $bitmask{$s}) { + $^H |= $explicit_bitmask{$s}; + + $bits |= $bitmask{$s}; + } + else { + push @wrong, $s; + } } if (@wrong) { require Carp; @@ -37,16 +57,21 @@ sub bits { $bits; } -my @default_bits = qw(refs subs vars); - sub import { shift; - $^H |= bits(@_ ? @_ : @default_bits); + $^H |= @_ ? &bits : all_bits | all_explicit_bits; } sub unimport { shift; - $^H &= ~ bits(@_ ? @_ : @default_bits); + + if (@_) { + $^H &= ~&bits; + } + else { + $^H &= ~all_bits; + $^H |= all_explicit_bits; + } } 1; diff --git a/lib/strict.t b/lib/strict.t index e067793..d6c6ed0 100644 --- a/lib/strict.t +++ b/lib/strict.t @@ -3,7 +3,7 @@ chdir 't' if -d 't'; @INC = '../lib'; -our $local_tests = 4; +our $local_tests = 6; require "../t/lib/common.pl"; eval qq(use strict 'garbage'); @@ -17,3 +17,11 @@ like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/); eval qq(no strict qw(foo bar)); like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/); + +eval 'use v5.12; use v5.10; ${"c"}'; +is($@, '', 'use v5.10 disables implicit strict refs'); + +eval 'use strict; use v5.10; ${"c"}'; +like($@, + qr/^Can't use string \("c"\) as a SCALAR ref while "strict refs" in use/, + "use v5.10 doesn't disable explicit strict ref"); diff --git a/pad.h b/pad.h index 7ee8a1c..207823a 100644 --- a/pad.h +++ b/pad.h @@ -53,7 +53,7 @@ struct padnamelist { #endif #if !defined(PERL_PADNAME_MINIMAL) && !defined(PERL_PADNAME_ALIGNED) -# define PERL_PADNAME_ALIGNED +# define PERL_PADNAME_MINIMAL #endif #define _PADNAME_BASE \ -- Perl5 Master Repository
