Revision: 851
Author: tim.bunce
Date: Thu Aug  6 16:33:35 2009
Log: Fixed caller() problem with perl <5.8.7, many thanks to Bram!
Synced t/test61-submerge.rdt.

http://code.google.com/p/perl-devel-nytprof/source/detail?r=851

Modified:
  /trunk/NYTProf.xs
  /trunk/lib/Devel/NYTProf.pm
  /trunk/t/test61-submerge.rdt

=======================================
--- /trunk/NYTProf.xs   Wed Aug  5 15:35:34 2009
+++ /trunk/NYTProf.xs   Thu Aug  6 16:33:35 2009
@@ -3221,8 +3221,11 @@
          I32 caller_subname_len;
          SV *sv;

-        /* I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool  
dumpops, STRLEN pvlim */
-        if (0) do_sv_dump(0, Perl_debug_log, fid_line_rvhv, 0, 5, 0, 100);
+        if (0) {
+            logwarn("Callers of %s:\n", called_subname);
+            /* level, *file, *sv, I32 nest, I32 maxnest, bool dumpops,  
STRLEN pvlim */
+            do_sv_dump(0, Perl_debug_log, fid_line_rvhv, 0, 5, 0, 100);
+        }

          /* iterate over callers to this sub ({ "subname[fid:line]" =>  
[ ... ] })  */
          hv_iterinit(fid_lines_hv);
=======================================
--- /trunk/lib/Devel/NYTProf.pm Wed Jul 15 05:44:35 2009
+++ /trunk/lib/Devel/NYTProf.pm Thu Aug  6 16:33:35 2009
@@ -39,6 +39,7 @@
          ? sub { goto &DB_profiler }    # workaround bug in old perl  
versions (slow)
          : \&DB_profiler;
  }
+sub sub { die "DB::sub" }              # needed for perl <5.8.7  
(<p...@24265)

  init_profiler();                       # provides true return value for  
module

=======================================
--- /trunk/t/test61-submerge.rdt        Sun Jul 26 12:54:21 2009
+++ /trunk/t/test61-submerge.rdt        Thu Aug  6 16:33:35 2009
@@ -28,10 +28,10 @@
  fid_fileinfo  2       sub     main::__ANON__[(eval 0)[test61-submerge.p:8]:1] 
1-1
  fid_fileinfo  2       call    1       main::foo       [ 1 0 0 0 0 0 0 
main::__ANON__[(eval  
0)[test61-submerge.p:8]:1] ]
  fid_fileinfo  3       [ (eval 0)[test61-submerge.p:8] 1 8 3 2 0 0 ]
+fid_fileinfo   3       sub     main::CORE:print        0-0
  fid_fileinfo  3       sub     main::__ANON__[(eval 0)[test61-submerge.p:8]:1] 
1-1
  fid_fileinfo  3       call    1       main::foo       [ 1 0 0 0 0 0 0 
main::__ANON__[(eval  
0)[test61-submerge.p:8]:1] ]
  fid_fileinfo  4       [ (eval 0)[test61-submerge.p:8] 1 8 4 2 0 0 ]
-fid_fileinfo   4       sub     main::CORE:print        0-0
  fid_fileinfo  4       sub     main::__ANON__[(eval 0)[test61-submerge.p:8]:1] 
1-1
  fid_fileinfo  4       call    1       main::foo       [ 1 0 0 0 0 0 0 
main::__ANON__[(eval  
0)[test61-submerge.p:8]:1] ]
  fid_line_time 1       4       [ 0 3 ]
@@ -50,7 +50,7 @@
  profile_modes fid_line_time   line
  profile_modes fid_sub_time    sub
  sub_subinfo   main::BEGIN     [ 1 0 0 0 0 0 0 0 ]
-sub_subinfo    main::CORE:print        [ 4 0 0 3 0 0 0 0 ]
+sub_subinfo    main::CORE:print        [ 3 0 0 3 0 0 0 0 ]
  sub_subinfo   main::CORE:print        called_by       1       4       [ 3 0 0 
0 0 0 0 main::foo ]
  sub_subinfo   main::__ANON__[(eval 0)[test61-submerge.p:8]:1] [ 2 1 1 3 0 0  
0 0 ]
  sub_subinfo   main::__ANON__[(eval 0)[test61-submerge.p:8]:1] called_by       
1       8        
[ 3 0 0 0 0 0 0 main::RUNTIME ]

--~--~---------~--~----~------------~-------~--~----~
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.

Group hosted at:  http://groups.google.com/group/develnytprof-dev
Project hosted at:  http://perl-devel-nytprof.googlecode.com
CPAN distribution:  http://search.cpan.org/dist/Devel-NYTProf

To post, email:  [email protected]
To unsubscribe, email:  [email protected]
-~----------~----~----~----~------~----~------~--~---

Reply via email to