root/Attribute-Profiled/trunk/t/00_Profiled.t

Revision 255 (checked in by miyagawa, 19 years ago)

add Hook::LexWrap?

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 use strict;
2 use Test::More tests => 6;
3
4 BEGIN { use_ok('Attribute::Profiled') }
5
6 package Catch;
7 sub TIEHANDLE {
8     my $class = shift;
9     bless { caught => '' }, $class;
10 }
11
12 sub PRINTF {
13     my($self, $fmt, @list) = @_;
14     $self->{caught} .= sprintf $fmt, @list;
15 }
16
17 sub PRINT {
18     my($self, @list) = @_;
19     $self->{caught} .= "@list";
20 }
21
22
23 package SomeClass;
24
25 sub new {
26     bless {}, shift;
27 }
28
29 sub method : Profiled {
30     my $self = shift;
31     return 'foo';
32 }
33
34 sub method2 : Profiled {
35     my $self = shift;
36     return (1, 2, 3);
37 }
38
39 sub method3 : Profiled {
40     my $self = shift;
41     return scalar caller;
42 }
43
44 package main;
45
46 my $catch = tie *STDERR, 'Catch';
47
48 my $foo = SomeClass->new;
49 is $foo->method, 'foo', 'retvalue preserved';
50
51 $foo->method for (1..10);
52
53 my @ret = $foo->method2;
54 ok eq_array(\@ret, [ 1, 2, 3 ]), 'wantarray check';
55
56 my $caller = $foo->method3;
57 is $caller, __PACKAGE__, 'caller preserved';
58
59
60 undef $Attribute::Profiled::_Profiler;
61
62 like $catch->{caught}, qr/11 trials of SomeClass::method/, '11 method';
63 like $catch->{caught}, qr/1 trial of SomeClass::method2/, '1 method2';
64
65
66
Note: See TracBrowser for help on using the browser.