Changeset 255

Show
Ignore:
Timestamp:
09/19/01 01:03:11
Author:
miyagawa
Message:

add Hook::LexWrap?

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • Attribute-Profiled/trunk/Changes

    r254 r255  
    11Revision history for Perl extension Attribute::Profiled. 
     2 
     30.03  Wed Sep 19 01:02:22 JST 2001 
     4        * Now caller works correctly thanks to Hook::LexWrap 
    25 
    360.02  Tue Sep 18 08:39:12 JST 2001 
  • Attribute-Profiled/trunk/Makefile.PL

    r234 r255  
    99        Test::More          => 0, 
    1010        Benchmark::Timer    => 0.5, 
     11        Hook::LexWrap       => 0.01, 
    1112    }, # e.g., Module::Name => 1.1 
    1213    'AUTHOR'            => 'Tatsuhiko Miyagawa <miyagawa@bulknews.net>', 
  • Attribute-Profiled/trunk/lib/Attribute/Profiled.pm

    r254 r255  
    55use warnings; 
    66 
    7 our $VERSION = '0.02'; 
     7our $VERSION = '0.03'; 
    88 
    99use Attribute::Handlers; 
     10use Hook::LexWrap; 
    1011 
    1112our $_Profiler; 
     
    1617    no warnings 'redefine'; 
    1718 
    18     *{$symbol} = sub { 
    19         unless ($_Profiler) { 
    20             $_Profiler = Benchmark::Timer::ReportOnDestroy->new; 
    21         } 
    22         $_Profiler->start("$package\::$meth"); 
    23         my @ret = wantarray ? $referent->(@_) : scalar $referent->(@_); 
    24         $_Profiler->stop("$package\::$meth"); 
    25         return wantarray ? @ret : $ret[0]; 
    26     }; 
     19    wrap $symbol, 
     20        pre  => sub { 
     21            unless ($_Profiler) { 
     22                $_Profiler = Benchmark::Timer::ReportOnDestroy->new; 
     23            } 
     24            $_Profiler->start("$package\::$meth"); 
     25        }, 
     26        post => sub { 
     27            $_Profiler->stop("$package\::$meth"); 
     28        }; 
    2729} 
    2830 
     
    7375C<$Attribute::Profiled::_Profiler>. 
    7476 
    75 =item * 
    76  
    77 Currently it's not caller sensitive (doesn't use goto). 
    78  
    7977=back 
    8078 
  • Attribute-Profiled/trunk/t/00_Profiled.t

    r254 r255  
    11use strict; 
    2 use Test::More tests => 4
     2use Test::More tests => 6
    33 
    44BEGIN { use_ok('Attribute::Profiled') } 
     
    3737} 
    3838 
     39sub method3 : Profiled { 
     40    my $self = shift; 
     41    return scalar caller; 
     42} 
     43 
    3944package main; 
    4045 
     
    4247 
    4348my $foo = SomeClass->new; 
    44 is($foo->method, 'foo', 'retvalue preserved')
     49is $foo->method, 'foo', 'retvalue preserved'
    4550 
    4651$foo->method for (1..10); 
    4752 
    4853my @ret = $foo->method2; 
    49 eq_array(\@ret, [ 1, 2, 3 ], 'wantarray check'); 
     54ok eq_array(\@ret, [ 1, 2, 3 ]), 'wantarray check'; 
     55 
     56my $caller = $foo->method3; 
     57is $caller, __PACKAGE__, 'caller preserved'; 
     58 
    5059 
    5160undef $Attribute::Profiled::_Profiler; 
    5261 
    53 like($catch->{caught}, qr/11 trials of SomeClass::method/, '11 method')
    54 like($catch->{caught}, qr/1 trial of SomeClass::method2/, '1 method2')
     62like $catch->{caught}, qr/11 trials of SomeClass::method/, '11 method'
     63like $catch->{caught}, qr/1 trial of SomeClass::method2/, '1 method2'
    5564 
    5665 
    5766 
    58  
    59