From e62b48942b0247c2b585de312377b0a364e234fe Mon Sep 17 00:00:00 2001 From: Reini Urban Date: Sun, 27 Feb 2011 23:48:07 +0100 Subject: [PATCH] 0.03_01 fixes for 5.10 - enabled block-level register/unregister - stabilized 11-integer.t left shift test (newlib) --- Build.PL | 2 +- Changes | 6 ++++- Makefile.PL | 28 +++++++++++++++++--- lib/optimize.pm | 62 +++++++++++++++++++++++++-------------------- lib/optimize/int.pm | 2 +- t/02-register.t | 2 +- t/11-integer.t | 11 ++++---- 7 files changed, 73 insertions(+), 40 deletions(-) mode change 100644 => 100755 Build.PL mode change 100644 => 100755 Makefile.PL diff --git a/Build.PL b/Build.PL old mode 100644 new mode 100755 index efd7434..afe02bc --- a/Build.PL +++ b/Build.PL @@ -13,7 +13,7 @@ my $build = Module::Build->new Hook::Scope => '0.02', 'B::Generate' => '1.05', 'optimizer' => '0.02', - 'perl' => '5.8', + 'perl' => '5.008', } ); $build->create_build_script(); diff --git a/Changes b/Changes index 8974d19..f87d202 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,10 @@ Revision history for Perl extension optimize -0.03 Sun Aug 11 23:45:10 CEST 2002 +0.03_01 2011-02-19 rurban + - enabled register/unregister + - stablized 11-integer left shift test + +0.03 Sun Aug 11 23:45:10 CEST 2002 abergman - Fixed bug when a constant was a AV in which we would get bizare copy of Array diff --git a/Makefile.PL b/Makefile.PL old mode 100644 new mode 100755 index 0cf163e..85c5438 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,4 +1,26 @@ +use 5.008; +use ExtUtils::MakeMaker; +WriteMakefile + ( + 'NAME' => 'optimize', + 'VERSION_FROM' => 'lib/optimize.pm', + 'PREREQ_PM' => + { + 'DynaLoader' => 0, + 'B::Generate' => '1.34' + }, + AUTHOR => 'Arthur Bergman', + ($ExtUtils::MakeMaker::VERSION gt '6.46' ? + ('META_MERGE' => + { + resources => + { + license => 'http://dev.perl.org/licenses/', + repository => 'http://github.com/rurban/optimize', + }, + } + ) : ()), + ); + +sub MY::depend { "README : lib/optimize.pm\n\tpod2text lib/optimize.pm > README\n"; } -use Module::Build::Compat; - Module::Build::Compat->run_build_pl(args => \@ARGV); - Module::Build::Compat->write_makefile(); diff --git a/lib/optimize.pm b/lib/optimize.pm index 8de3355..0ff4b48 100644 --- a/lib/optimize.pm +++ b/lib/optimize.pm @@ -1,4 +1,3 @@ - use strict; package optimize; @@ -8,28 +7,31 @@ use B::Utils qw(walkallops_simple); use B qw(OPf_KIDS OPf_MOD OPf_PARENS OPf_WANT_SCALAR OPf_STACKED); use Attribute::Handlers; use Hook::Scope qw(POST); -our $VERSION = 0.03; +our $VERSION = "0.03_01"; our %pads; our $state; our $old_op; our %loaded; -our $stash; +our $stash = ''; our %register; -use optimizer "extend-c" => sub { + +use optimizer "extend-c" => sub { my $op = shift; - POST { $old_op = $op; return () }; + POST(sub{$old_op = $op;()}); + return unless $op; if($op->name eq 'nextstate') { $state = $op; $stash = $state->stash->NAME; -# print $state->file . ":" . $state->line . "-" . $state->stash->NAME . "\n";; - } - if($stash =~/^(optimize|B::|type|float|int|^O$)/) { -# print "Don't optimize ourself\n"; - return; + # print $state->file . ":" . $state->line . "-" . $state->stash->NAME . "\n"; + + if($stash =~/^(optimize|B::|types$|float$|double$|int$|number$|^O$)/) { + # print "Don't optimize ourself\n"; + return; + } } -# print "$op - " . $op->name . " - " . $op->next . " - " . ($op->next->can('name') ? $op->next->name : "") . "\n"; + # print "$op - " . $op->name . " - " . $op->next . " - " . ($op->next->can('name') ? $op->next->name : "") . "\n"; my $cv; eval { $cv = $op->find_cv; @@ -39,32 +41,29 @@ use optimizer "extend-c" => sub { print "$@ in " . $state->file . ":" . $state->line . "\n";; return; } - - - - if($op->name eq 'const' && ref($op->sv) eq 'B::PV' && - $op->sv->sv eq 'attributes' && + $op->sv->sv eq 'attributes' && $op->can('next') && $op->next->can('next') && $op->next->next->can('next') && $op->next->next->next->can('next') && $op->next->next->next->next->can('next') && - $op->next->next->next->next->next->can('next') && + $op->next->next->next->next->next->can('next') && + $op->next->next->next->next->next->next && $op->next->next->next->next->next->next->name eq 'method_named' && - $op->next->next->next->next->next->next->sv->sv eq 'import') { - - #Here we establish that this is an use of attributes on lexicals - #however we want to establish what attribute it is + $op->next->next->next->next->next->next->sv->sv eq 'import') + { + # Here we establish that this is an use of attributes on lexicals + # however we want to establish what attribute it is my $attribute = $op->next->next->next->next->next->sv->sv; if($attribute =~/^optimize\(\s*(.*)\s*\)/) { -# print "$attribute\n"; + # print "$attribute\n"; my @attributes = split /\s*,\s*/, $1; -# print "GOT " . join("-", @attributes) . "\n"; + # print "GOT " . join("-", @attributes) . "\n"; if($op->next->next->name eq 'padsv') { my $sv = (($cv->PADLIST->ARRAY)[0]->ARRAY)[$op->next->next->targ]; @@ -81,10 +80,11 @@ use optimizer "extend-c" => sub { } for (values %loaded) { -# print "Calling $_\n"; + # print "Calling $_\n"; $_->check($op); -# print "Called $_\n"; + # print "Called $_\n"; } + # calling types if(exists($register{$stash})) { for my $callback (values %{$register{$stash}}) { if($callback) { @@ -111,9 +111,12 @@ sub unregister { } sub UNIVERSAL::optimize : ATTR { - + ; } +1; +__END__ + =head1 NAME optimize - Pragma for hinting optimizations on variables @@ -154,4 +157,9 @@ L L =cut -1; +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: diff --git a/lib/optimize/int.pm b/lib/optimize/int.pm index b187e24..944f995 100644 --- a/lib/optimize/int.pm +++ b/lib/optimize/int.pm @@ -23,7 +23,7 @@ sub check { if(exists($int{$op->name})) { my $cv = $op->find_cv(); if(exists($optimize::pads{$cv->ROOT->seq}) && - $optimize::pads{$cv->ROOT->seq}->[$op->targ]->[1]->{int}) { + $optimize::pads{$cv->ROOT->seq}->[$op->targ]->[1]->{int}) { $mutate++; } elsif($op->can('first') && $op->first->name eq 'padsv' && exists($optimize::pads{$cv->ROOT->seq}) && diff --git a/t/02-register.t b/t/02-register.t index d9097a5..3db54e1 100644 --- a/t/02-register.t +++ b/t/02-register.t @@ -1,5 +1,5 @@ -use Test::More tests=> 9; +use Test::More tests=> 7; use optimize; package foo; diff --git a/t/11-integer.t b/t/11-integer.t index 22b6dd6..6ecc5dd 100644 --- a/t/11-integer.t +++ b/t/11-integer.t @@ -1,7 +1,5 @@ #!./perl - - use Test::More tests => 11; use Config; use optimize; @@ -28,13 +26,13 @@ $z = $x / $y; is($z, 0, "modulo"); is($x, 4.5, "scalar still floating point"); - + isnt(sqrt($x), 2, "functions still floating point"); - + isnt($x ** .5, 2, "power still floating point"); is(++$x, 5.5, "++ still floating point"); - + SKIP: { my $ivsize = $Config{ivsize}; skip "ivsize == $ivsize", 2 unless $ivsize == 4 || $ivsize == 8; @@ -44,7 +42,8 @@ SKIP: { is($z + 1, -2147483648, "left shift"); } elsif ($ivsize == 8) { $z = 2**63 - 1; - is($z + 1, -9223372036854775808, "left shift"); + my $i = $z + 1; + ok("$i" =~ /-922337203685477580[6-9]$/, "left shift"); } } $z = 0;