├── .appveyor.yml ├── .gdbinit ├── .gitignore ├── .indent.pro ├── .perltidyrc ├── .travis.yml ├── Changes ├── FileHandle.h ├── FileHandle.xs ├── HACKING ├── INSTALL ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── MemoryProfiling.pod ├── NYTProf.h ├── NYTProf.xs ├── README.md ├── bin ├── flamegraph.pl ├── nytprofcalls ├── nytprofcg ├── nytprofcsv ├── nytprofhtml └── nytprofmerge ├── change-version.sh ├── demo ├── 1m_stmts.pl ├── README ├── closure.pl ├── cpucache.pl ├── demo-code.pl ├── demo-run.pl └── exclusive-sub-time.pl ├── devstuff ├── Ex01 │ ├── Loops.pm │ ├── Moose.pm │ ├── Slowops.pm │ ├── Statements.pm │ ├── Subcall.pm │ └── Subs.pm ├── accept.pl ├── eval-fid-ordering.patch ├── example.pl ├── foo.pl ├── superseded.pm └── superseded.xs ├── lib └── Devel │ ├── NYTProf.pm │ └── NYTProf │ ├── Apache.pm │ ├── Constants.pm │ ├── Core.pm │ ├── Data.pm │ ├── FileHandle.pm │ ├── FileInfo.pm │ ├── ReadStream.pm │ ├── Reader.pm │ ├── Run.pm │ ├── SubCallInfo.pm │ ├── SubInfo.pm │ ├── Test.pm │ ├── Util.pm │ └── js │ ├── asc.png │ ├── bg.png │ ├── desc.png │ ├── jit │ ├── Treemap.css │ ├── gradient-cushion1.png │ ├── gradient.png │ ├── gradient20.png │ ├── gradient30.png │ ├── gradient40.png │ ├── gradient50.png │ ├── jit-yc.js │ └── jit.js │ ├── jquery-min.js │ ├── jquery.tablesorter.min.js │ └── style-tablesorter.css ├── ppport.h ├── slowops.h ├── t ├── 00-load.t ├── 10-run.t ├── 11-reader.t ├── 12-data.t ├── 13-fileinfo.t ├── 14-subinfo.t ├── 22-readstream.t ├── 30-util.t ├── 31-env.t ├── 40-savesrc.t ├── 42-global.t ├── 44-model.t ├── 50-errno.t ├── 60-forkdepth.t ├── 70-subname.t ├── 80-version.t ├── 90-pod.t ├── lib │ └── NYTProfTest.pm ├── nytprof_11-reader.out.txt ├── nytprof_12-data.out.txt ├── nytprof_13-data.out.txt ├── nytprof_14-subinfo.out.txt ├── test01.calls ├── test01.p ├── test01.rdt ├── test01.t ├── test01.x ├── test02.calls ├── test02.p ├── test02.pf ├── test02.pf.csv ├── test02.rdt ├── test02.t ├── test02.x ├── test03.calls ├── test03.p ├── test03.rdt ├── test03.t ├── test03.x ├── test05.calls ├── test05.p ├── test05.rdt ├── test05.t ├── test05.x ├── test06.calls ├── test06.p ├── test06.rdt ├── test06.t ├── test06.x ├── test07.calls ├── test07.p ├── test07.rdt ├── test07.t ├── test07.x ├── test08.calls ├── test08.p ├── test08.rdt ├── test08.t ├── test08.x ├── test09.calls ├── test09.p ├── test09.rdt ├── test09.t ├── test09.x ├── test10.calls ├── test10.p ├── test10.rdt ├── test10.t ├── test10.x ├── test11.calls ├── test11.p ├── test11.rdt ├── test11.t ├── test11.x ├── test12.calls ├── test12.p ├── test12.pl ├── test12.rdt ├── test12.t ├── test12.x ├── test13.calls ├── test13.p ├── test13.rdt ├── test13.t ├── test13.x ├── test14.p ├── test14.pm ├── test14.pm_x ├── test14.rdt ├── test14.t ├── test14.x ├── test16.calls ├── test16.p ├── test16.rdt ├── test16.t ├── test16.x ├── test17-goto.calls ├── test17-goto.p ├── test17-goto.rdt ├── test17-goto.t ├── test18-goto2.calls ├── test18-goto2.p ├── test18-goto2.pm ├── test18-goto2.t ├── test20-streval.calls ├── test20-streval.p ├── test20-streval.rdt ├── test20-streval.t ├── test20-streval.x ├── test21-streval3.calls ├── test21-streval3.p ├── test21-streval3.rdt ├── test21-streval3.t ├── test21-streval3.x ├── test22-strevala.calls ├── test22-strevala.p ├── test22-strevala.rdt ├── test22-strevala.t ├── test23-strevall.calls ├── test23-strevall.p ├── test23-strevall.rdt ├── test23-strevall.t ├── test24-strevalc.calls ├── test24-strevalc.p ├── test24-strevalc.rdt ├── test24-strevalc.t ├── test25-strevalb.t ├── test30-fork-0.calls ├── test30-fork-0.p ├── test30-fork-0.rdt ├── test30-fork-0.t ├── test30-fork-0.x ├── test30-fork-1.rdt ├── test30-fork-1.x ├── test40pmc.calls ├── test40pmc.p ├── test40pmc.pm ├── test40pmc.pm_x ├── test40pmc.pmc ├── test40pmc.rdt ├── test40pmc.t ├── test40pmc.x ├── test50-disable.calls ├── test50-disable.p ├── test50-disable.rdt ├── test50-disable.t ├── test50-disable.x ├── test51-enable.calls ├── test51-enable.p ├── test51-enable.rdt ├── test51-enable.t ├── test51-enable.x ├── test60-subname.calls ├── test60-subname.p ├── test60-subname.rdt ├── test60-subname.t ├── test61-submerge.calls ├── test61-submerge.p ├── test61-submerge.rdt ├── test61-submerge.t ├── test62-subcaller1-a.calls ├── test62-subcaller1-a.p ├── test62-subcaller1-a.rdt ├── test62-subcaller1-a.t ├── test62-subcaller1-b.calls ├── test62-subcaller1-b.p ├── test62-subcaller1-b.rdt ├── test62-subcaller1-b.t ├── test62-tie-a.calls ├── test62-tie-a.p ├── test62-tie-a.rdt ├── test62-tie-a.t ├── test62-tie-b.calls ├── test62-tie-b.p ├── test62-tie-b.rdt ├── test62-tie-b.t ├── test70-subexcl.calls ├── test70-subexcl.p ├── test70-subexcl.t ├── test80-recurs.calls ├── test80-recurs.p ├── test80-recurs.rdt ├── test80-recurs.t ├── test81-swash.t ├── test82-version.t ├── test90-strsubref.t └── zzz.t ├── typemap └── xt ├── 61-cputime.t ├── 68-hashline.t ├── 71-moose.t ├── 72-autodie.t ├── 91-pod_coverage.t ├── 92-file_port.t ├── test23-strevalxs.p ├── test23-strevalxs.rdt ├── test23-strevalxs.t ├── test45-overload.p ├── test71-while.p ├── test82-stress.t └── test90-stress.p /.appveyor.yml: -------------------------------------------------------------------------------- 1 | version: 1.0.{build} 2 | 3 | branches: 4 | except: 5 | - /travis/ 6 | skip_tags: true 7 | 8 | cache: 9 | - C:\strawberry -> appveyor.yml 10 | 11 | install: 12 | - if not exist "C:\strawberry" cinst strawberryperl 13 | - set PATH=C:\strawberry\perl\bin;C:\strawberry\perl\site\bin;C:\strawberry\c\bin;%PATH% 14 | - cd C:\projects\%APPVEYOR_PROJECT_NAME% 15 | - cpanm --installdeps --notest --with-all-features . 16 | 17 | build_script: 18 | - perl Makefile.PL 19 | - gmake 20 | 21 | test_script: 22 | - gmake test 23 | 24 | notifications: 25 | - provider: Email 26 | to: 27 | - jkeenan@cpan.org 28 | on_build_status_changed: true 29 | 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # / 2 | FileHandle.c 3 | FileHandle.o 4 | MANIFEST.bak 5 | MYMETA.json 6 | MYMETA.yml 7 | Makefile 8 | Makefile.old 9 | NYTProf.bs 10 | NYTProf.c 11 | NYTProf.o 12 | blib/ 13 | *.tar.gz 14 | *.o 15 | *.obj 16 | *.pdb 17 | *.def 18 | *.c 19 | *.bs 20 | *.out 21 | .*.swp 22 | nytprof-50-errno.out 23 | /t/*.new 24 | /t/*.newp 25 | /t/*.out 26 | /t/*.calls_new 27 | /t/*.rdt_new 28 | /t/*.rdt_newp 29 | /t/nytprof_t.out 30 | /t/nytprof-test51-*.out 31 | /t/nytprof_test30-fork-*.out.* 32 | /t/*_outdir 33 | /t/auto 34 | pm_to_blib 35 | /_eumm/ 36 | dll.base 37 | dll.exp 38 | NYTProf_def.old 39 | /cover_db/ 40 | MYMETA.json.lock 41 | Devel-NYTProf-*/ 42 | -------------------------------------------------------------------------------- /.indent.pro: -------------------------------------------------------------------------------- 1 | -i4 2 | -nce 3 | -nfc1 4 | -l98 5 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | # Perl Best Practices (plus errata) .perltidyrc file 2 | 3 | -l=98 # Max line width is 98 cols 4 | -i=4 # Indent level is 4 cols 5 | -ci=4 # Continuation indent is 4 cols 6 | -st # Output to STDOUT 7 | -se # Errors to STDERR 8 | -vt=2 # Maximal vertical tightness 9 | -cti=0 # No extra indentation for closing brackets 10 | -pt=1 # Medium parenthesis tightness 11 | -bt=1 # Medium brace tightness 12 | -sbt=1 # Medium square bracket tightness 13 | -bbt=1 # Medium block brace tightness 14 | -nsfs # No space before semicolons 15 | -nolq # Don't outdent long quoted strings 16 | -wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" 17 | # Break before all operators 18 | 19 | # extras/overrides/deviations from PBP 20 | 21 | #--maximum-line-length=100 # be slightly more generous 22 | --warning-output # Show warnings 23 | --maximum-consecutive-blank-lines=2 # default is 1 24 | --nohanging-side-comments # troublesome for commented out code 25 | 26 | -isbc # block comments may only be indented if they have some space characters before the # 27 | 28 | # for the up-tight folk :) 29 | -pt=2 # High parenthesis tightness 30 | -bt=2 # High brace tightness 31 | -sbt=2 # High square bracket tightness 32 | 33 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | 3 | perl: 4 | - "blead" 5 | - "5.32" 6 | - "5.30" 7 | - "5.28" 8 | - "5.26" 9 | - "dev" 10 | - "5.24" 11 | - "5.24-extras" 12 | - "5.22" 13 | - "5.22-extras" 14 | - "5.20" 15 | - "5.20-extras" 16 | - "5.18" 17 | - "5.18-extras" 18 | - "5.16" 19 | - "5.14" 20 | - "5.12" 21 | - "5.10" 22 | - "5.8" 23 | 24 | sudo: false # faster builds as long as you don't need sudo access 25 | 26 | before_install: 27 | - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers 28 | - source ~/travis-perl-helpers/init 29 | - build-perl 30 | - perl -V 31 | - build-dist 32 | - cd $BUILD_DIR # $BUILD_DIR is set by the build-dist command 33 | 34 | install: 35 | - cpan-install --deps # installs prereqs, including recommends 36 | - cpanm Test::Pod Test::Pod::Coverage || true 37 | - cpanm Test::Portability::Files || true 38 | 39 | matrix: 40 | fast_finish: true 41 | allow_failures: 42 | - perl: blead 43 | 44 | notifications: 45 | email: 46 | recipients: 47 | - timb@cpan.org 48 | - jkeenan@cpan.org 49 | on_success: never 50 | on_failure: always 51 | irc: "irc.perl.org#nytprof" 52 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | # vim: ts=8 sw=2 sts=0 noexpandtab: 2 | 3 | Devel::NYTProf Installation Notes 4 | ================================= 5 | 6 | For the most part, users on Unix-like operating system can do: 7 | 8 | perl Makefile.PL 9 | make 10 | make test 11 | make install 12 | 13 | The module library tried to speed thing up when running in forkmode by using 14 | fpruge() to delete potential duplicated buffers. Unfortunately, althrough 15 | fpurge() *is* in the GNU manual, operating systems largely implement it very 16 | differently. The Makefile.PL does some magic to find out where your particular 17 | version of fpurge is. Usually it can be found in stdio.h or stdio_ext.h, so 18 | make sure those are in your INCLUDE path. It is also sometimes named fpurge 19 | _fpurge or __fpurge. 20 | 21 | COMPILE NOTES 22 | 23 | The module was written to compile silently with -Wall -pedantic -ansi. Some 24 | warnings might be generated from methods like XS_blah. These are in Perl 25 | generated code and cannot be fixed by me. 26 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | \B\.git\b 2 | ^MANIFEST\. 3 | ^Makefile$ 4 | ^Makefile.old$ 5 | \.DS_Store$ 6 | ~$ 7 | ^blib/ 8 | ^devstuff/ 9 | ^Devel-NYTProf-\d 10 | ^flametests/ 11 | ^MYMETA\.\w+$ 12 | ^t.pl$ 13 | ^TODO$ 14 | ^change-version\.sh$ 15 | ^appveyor\.yml$ 16 | ^.appveyor\.yml$ 17 | ^FileHandle.c$ 18 | ^FileHandle.o$ 19 | ^NYTProf.bs$ 20 | ^NYTProf.c$ 21 | ^NYTProf.o$ 22 | ^pm_to_blib$ 23 | ^\.swp$ 24 | ^cover_db/ 25 | ^t/auto/ 26 | ^t/.*\.out$ 27 | t/nytprof_test30-fork-0\.out\.\d+$ 28 | t/test.*outdir/ 29 | ^travis\.yml$ 30 | ^.travis\.yml$ 31 | -------------------------------------------------------------------------------- /MemoryProfiling.pod: -------------------------------------------------------------------------------- 1 | =head1 Ideas and Plans for Memory Profiling with NYTProf 2 | 3 | XXX I. 4 | Somewhere to gather the info so it'll be easier to find when someone 5 | wants to work on it. 6 | 7 | It's also focussed on runtime profiling of total memory usage over time 8 | (rather than a detailed analysis of who 'owns' what memory as some particular 9 | point in time, like the end of the program). 10 | 11 | NYTProf currently only measures time and supports a limited range of "clocks" 12 | (realtime vs cputime). For profiling memory we need to add a new kind of 13 | "clock" that measures memory usage. Since we're generalizing the concept of 14 | what gets measured (and how we get the info from the system) a better name 15 | than "clock" would be "probe". 16 | 17 | Conjectural terminology: 18 | 19 | "Probe" means some measuring mechanism like get_clock(), times(), getrusage(), 20 | that may yield multiple pieces of information with a single call. 21 | 22 | "Measure" is one specific item generated by a probe. 23 | 24 | Probe "time" uses times(), measures: "time.user", "time.user+sys" etc 25 | Probe "clock" uses clock_gettime(), measures: "clock.realtime", "clock.monotonic" etc 26 | Probe "rusage" uses getrusage(), measures: "rusage.majflt", "rusage.nvcsw" etc 27 | Probe "memory" measures: "memory.bytes", "mem.allocs" etc 28 | Probe "arena" measures: "arena.svs", "arena.bytes" etc 29 | 30 | Generalize the concepts of probes. Have a structure defining a 'probe' with 31 | pointers to functions to get the values, subtract values to get relative ticks, 32 | return the tick units etc. Give them names and attributes (cpu, realtime etc). 33 | User could then pick a probe by name. By default we'd pick the best available 34 | realtime probe. 35 | Use the subtraction logic where we currently handle times in the statement and 36 | subroutine profilers. 37 | 38 | =head1 Email threads 39 | 40 | "Memory profiling in Devel::NYTProf?: - June 2009 41 | http://groups.google.com/group/develnytprof-dev/browse_frm/thread/1df4cba3001cd4e4/136812b44e9f7631 42 | Talking about the problems of measuring memory usage of the whole process re: 43 | http://blog.robin.smidsrod.no/index.php/2009/05/26/memory-footprint-of-popular-cpan-modules 44 | 45 | "Memory profiling possibilities in NYTProf" - September 2009 46 | http://groups.google.com/group/develnytprof-dev/browse_frm/thread/c711c132216a3cea/035012e3dc2971ec 47 | This includes a detailed overview of the issues. 48 | 49 | "profiling memory" - Dec 2009 50 | http://groups.google.com/group/develnytprof-dev/browse_frm/thread/5ffd24200866b0c1/201b58c18d826aaa 51 | Nicholas Clark offers an experimental patch that intercepts malloc and free 52 | and makes NYTProf measure memory usage. 53 | 54 | =head1 Possibly Relevant Perl Modules 55 | 56 | Per-process memory information: 57 | 58 | http://metacpan.org/pod/Devel::Mallinfo 59 | 60 | Arena, stash, and pad based memory reporters: 61 | 62 | http://metacpan.org/pod/Devel::Gladiator 63 | http://metacpan.org/release/Internals-DumpArenas/ 64 | http://metacpan.org/release/Internals-GraphArenas/ 65 | http://metacpan.org/pod/Devel::DumpSizes 66 | http://metacpan.org/pod/Devel::Arena 67 | 68 | Per-object memory size reporters: 69 | 70 | http://metacpan.org/pod/Devel::Size 71 | http://metacpan.org/pod/Devel::Size::Report 72 | 73 | Others: 74 | 75 | http://metacpan.org/release/Devel-Memalyzer/ 76 | http://metacpan.org/pod/Devel::Memalyzer::Plugin::ProcSmaps 77 | 78 | =head1 Other Items of Interest 79 | 80 | "Memory Efficient Perl" slides by jjore 81 | 82 | http://docs.google.com/present/view?id=dg7kgpct_24cjs3c9fv 83 | http://diotalevi.isa-geek.net/~josh/090402/frontend.png 84 | 85 | Other profile/memory visualization tools 86 | 87 | http://netjam.org/spoon/viz/ 88 | http://java.dzone.com/announcements/visualvm-12-great-java 89 | 90 | http://blogs.perl.org/users/alex_balhatchet/2012/01/debugging-memory-use-in-perl---help.html 91 | 92 | http://stackoverflow.com/questions/8715611/can-i-use-dtrace-on-os-x-10-5-to-determine-which-of-my-perl-subs-is-causing-the 93 | 94 | =cut 95 | -------------------------------------------------------------------------------- /NYTProf.h: -------------------------------------------------------------------------------- 1 | /* vim: ts=8 sw=4 expandtab: 2 | * ************************************************************************ 3 | * This file is part of the Devel::NYTProf package. 4 | * Copyright 2008 Adam J. Kaplan, The New York Times Company. 5 | * Copyright 2008 Tim Bunce, Ireland. 6 | * Released under the same terms as Perl 5.8 7 | * See http://metacpan.org/release/Devel-NYTProf/ 8 | * 9 | * Contributors: 10 | * Adam Kaplan, akaplan at nytimes.com 11 | * Tim Bunce, http://blog.timbunce.org 12 | * Steve Peters, steve at fisharerojo.org 13 | * 14 | * ************************************************************************ 15 | */ 16 | 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Devel::NYTProf 2 | 3 | Devel::NYTProf is a powerful feature-rich source code profiler for Perl 5. 4 | 5 | For more information see: 6 | 7 | * https://www.youtube.com/watch?v=T7EK6RZAnEA 8 | * http://www.slideshare.net/Tim.Bunce/nyt-prof-201406key 9 | * http://blog.timbunce.org/tag/nytprof/ 10 | 11 | ## DOWNLOAD AND INSTALLATION 12 | 13 | Download a release from CPAN using your favorite tool, such as cpanm. Or else 14 | from https://metacpan.org/release/Devel-NYTProf and then unpack the tar.gz file. 15 | 16 | You're most welcome to contribute, in which case cloning or forking the git 17 | repo is a good place to start. 18 | 19 | To build and install, just incant the typical mantra: 20 | 21 | perl Makefile.PL 22 | make 23 | make test 24 | make install 25 | 26 | -------------------------------------------------------------------------------- /change-version.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh -xe 2 | 3 | make clean || true 4 | 5 | perl -p -i -e "s/\\b$1\\b/$2/ if /VERSION\s*=/" \ 6 | bin/* \ 7 | lib/Devel/NYTProf.pm lib/Devel/NYTProf/Core.pm 8 | 9 | ack --literal "$1" 10 | ack --literal "$2" 11 | -------------------------------------------------------------------------------- /demo/1m_stmts.pl: -------------------------------------------------------------------------------- 1 | # execute 1 million iterations of a 3 statement + condition loop 2 | my $i = shift || 1_000_000; 3 | while (--$i) { 4 | 1; 5 | ++$a; 6 | 1; 7 | } 8 | -------------------------------------------------------------------------------- /demo/README: -------------------------------------------------------------------------------- 1 | This directory holds tools and script for demonstrating Devel::NYTProf 2 | (Feel free to ignore it.) 3 | -------------------------------------------------------------------------------- /demo/closure.pl: -------------------------------------------------------------------------------- 1 | 2 | 3 | our $o; 4 | 5 | for my $i (1..100_000) { 6 | 7 | my $named2 = \&bar; sub bar { return 1; 1+$l } # non-closure 8 | my $named1 = \&foo; sub foo { return 1; 1+$o } # non-closure 9 | my $anon1 = sub { return 1; 1+$o }; # non-closure 10 | my $anon2 = sub { return 1; 1+$l }; # closure 11 | 12 | $named2->(); 13 | $named1->(); # faster because of cpu cache of opcode logic? 14 | $anon1->(); 15 | $anon2->(); 16 | 17 | 1; # loop 18 | } 19 | -------------------------------------------------------------------------------- /demo/cpucache.pl: -------------------------------------------------------------------------------- 1 | 2 | 3 | my $subref = sub { return }; 4 | 5 | for my $i (1..100_000) { 6 | 7 | some_expensive_sub(); 8 | 9 | $subref->(); 10 | $subref->(); # identical but faster! 11 | 12 | 1; # loop 13 | } 14 | 15 | sub some_expensive_sub{ 16 | 17 | my @x = (1000..1010); 18 | m/x/ for @x; 19 | 20 | } 21 | -------------------------------------------------------------------------------- /demo/demo-code.pl: -------------------------------------------------------------------------------- 1 | use strict 0.1; # use UNIVERSAL::VERSION 2 | use English; # demo detection of $& et al 3 | use Benchmark; 4 | use File::Find; 5 | 6 | my $count = shift || 100; 7 | my $do_io = shift || (not -t STDIN); 8 | 9 | sub add { 10 | $a = $a + 1; 11 | foo(); 12 | } 13 | 14 | sub foo { 15 | 1; 16 | for (1..1000) { 17 | ++$a; 18 | ++$a; 19 | } 20 | 1; 21 | } 22 | 23 | BEGIN { add() } 24 | BEGIN { add() } 25 | 26 | sub inc { 27 | 1; 28 | # call foo and then execute a slow expression *in the same statement* 29 | # With all line profilers except NYTProf, the time for that expression gets 30 | # assigned to the previous statement, i.e., the last statement executed in foo()! 31 | # XXX this doesn't seem to be slow in 5.12+ - need a better example 32 | foo() && 'aaaaaaaaaaa' =~ /((a{0,5}){0,5})*[c]/; 33 | 34 | 1; 35 | } 36 | 37 | timethese( $count, { 38 | add => \&add, 39 | bar => \&inc, 40 | }); 41 | 42 | END { 43 | warn "ENDING\n"; 44 | add() 45 | } 46 | 47 | 48 | # --- recursion --- 49 | 50 | sub fib { 51 | my $n = shift; 52 | return $n if $n < 2; 53 | fib($n-1) + fib($n-2); 54 | } 55 | fib(7); 56 | 57 | # --- File::Find --- 58 | 59 | sub wanted { 60 | return 1; 61 | } 62 | 63 | find( \&wanted, '.'); 64 | 65 | 66 | # --- while with slow conditional --- 67 | 68 | if ($do_io) { 69 | print "Enter text. Enter empty line to end.\n" if -t STDIN; 70 | # time waiting for the second and subsequent inputs 71 | # should get assigned to the condition statement 72 | # not the last statement executed in the loop 73 | while (<>) { 74 | chomp; 75 | last if not $_; 76 | 1; 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /demo/demo-run.pl: -------------------------------------------------------------------------------- 1 | #!/bin/env perl -w 2 | use strict; 3 | use IO::Handle; 4 | 5 | my $NYTPROF = ($ENV{NYTPROF}) ? "$ENV{NYTPROF}:" : ""; 6 | 7 | my %runs = ( 8 | start_begin => { 9 | skip => 0, 10 | NYTPROF => 'start=begin:optimize=0', 11 | }, 12 | start_check => { 13 | skip => 1, 14 | NYTPROF => 'start=init:optimize=0', 15 | }, 16 | start_end => { 17 | skip => 1, 18 | NYTPROF => 'start=end:optimize=0', 19 | }, 20 | ); 21 | 22 | 23 | for my $run (keys %runs) { 24 | 25 | next if $runs{$run}{skip}; 26 | $ENV{NYTPROF} = $NYTPROF . $runs{$run}{NYTPROF} || ''; 27 | $ENV{NYTPROF_HTML} = $runs{$run}{NYTPROF_HTML} || ''; 28 | 29 | my $cmd = "perl -d:NYTProf demo/demo-code.pl @ARGV"; 30 | open my $fh, "| $cmd" 31 | or die "Error starting $cmd\n"; 32 | 33 | # feed data into the stdin read loop in demo/demo-code.pl 34 | $fh->autoflush; 35 | print $fh "$_\n" for (1..10); 36 | sleep 2; 37 | print $fh "$_\n" for (1..10); 38 | close $fh 39 | or die "Error closing pipe to $cmd: $!\n"; 40 | 41 | my $outdir = "demo-out/profiler-$run"; 42 | system("rm -rf $outdir") == 0 or exit 0; 43 | system("mkdir -p $outdir") == 0 or exit 0; 44 | system("perl -Mblib bin/nytprofhtml --open --out=$outdir") == 0 45 | or exit 0; 46 | 47 | #system "ls -lrt $outdir/."; 48 | 49 | sleep 1; 50 | } 51 | 52 | -------------------------------------------------------------------------------- /demo/exclusive-sub-time.pl: -------------------------------------------------------------------------------- 1 | # for testing exclusive time calculations 2 | # use with NYTPROF=trace=3 3 | sub a { 4 | sleep 2; 5 | b(); 6 | } 7 | sub b { 8 | sleep 5; 9 | c(); 10 | } 11 | sub c { 12 | sleep 3; 13 | } 14 | a(); 15 | -------------------------------------------------------------------------------- /devstuff/Ex01/Loops.pm: -------------------------------------------------------------------------------- 1 | package Ex01::Loops; 2 | 3 | @a = (1..1000); 4 | 5 | for my $a (@a) { # without continue 6 | 1; 7 | 1; # note A 8 | } 9 | 10 | for my $a (@a) { # note A # with continue 11 | 1; 12 | 1; 13 | } 14 | continue { 15 | 1; 16 | 1; 17 | } 18 | 19 | # note A: cost of preparing next iteration appears here 20 | 21 | 1; 22 | -------------------------------------------------------------------------------- /devstuff/Ex01/Moose.pm: -------------------------------------------------------------------------------- 1 | package Ex02::Moose; 2 | 3 | use Moose; 4 | 5 | has foo => ( is=>'rw', default => sub { 42 } ); 6 | 7 | $a = Ex02::Moose->new; 8 | $a->foo; 9 | $a->foo(24); 10 | 11 | 1; 12 | -------------------------------------------------------------------------------- /devstuff/Ex01/Slowops.pm: -------------------------------------------------------------------------------- 1 | package Ex01::Slowops; 2 | 3 | @a = (1..1000); 4 | 5 | open my $fh, ">", $file = "deleteme.txt"; 6 | print $fh "$_\n" for @a; 7 | close $fh; 8 | unlink $file; 9 | 10 | $a = "a" x 1000; 11 | $a =~ m/((a{0,5}){0,5})*[c]/; 12 | $a =~ s/((a{0,5}){0,5})/1/; 13 | 14 | $b = "N\x{100}"; 15 | chop $b; 16 | s/ (?: [A-Z] | [\d] )+ (?= [\s] ) //x; 17 | s/ (?: [A-Z] | [\d] )+ (?= [\s] ) //x; 18 | 19 | sub dummy {} 20 | 21 | 1; 22 | -------------------------------------------------------------------------------- /devstuff/Ex01/Statements.pm: -------------------------------------------------------------------------------- 1 | package Ex01::Statements; 2 | 3 | my $a = 42; 4 | 5 | $a++; 6 | $a++; 7 | $a++; 8 | 9 | $a += 1; 10 | $a += 1; 11 | $a += 1; 12 | 13 | $a = $a + 1; 14 | $a = $a + 1; 15 | $a = $a + 1; 16 | 17 | 1; 18 | -------------------------------------------------------------------------------- /devstuff/Ex01/Subcall.pm: -------------------------------------------------------------------------------- 1 | package Ex01::Subcall; 2 | 3 | sub a { 4 | goto &b; 5 | } 6 | sub b { 7 | sleep 1; # time here not includes in a() inclusive time 8 | } 9 | a(); 10 | 11 | 1; 12 | -------------------------------------------------------------------------------- /devstuff/Ex01/Subs.pm: -------------------------------------------------------------------------------- 1 | package Ex01::Subs; 2 | 3 | @a = (1..1000); 4 | 5 | sub empty { 6 | } 7 | empty() for @a; 8 | empty(@a) for @a; 9 | 10 | 11 | sub args { 12 | my @args = @_; 13 | } 14 | args(@a) for @a; 15 | 16 | call_a(@a) for @a; 17 | sub call_a { 18 | my @args = @_; 19 | call_b(@args); 20 | } 21 | sub call_b { 22 | my @args = @_; 23 | } 24 | 25 | sub fib { # recursion 26 | my $n = shift; 27 | return $n if $n < 2; 28 | fib($n-1) + fib($n-2); # time recursing not shown 29 | } 30 | fib(10); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /devstuff/accept.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Socket; 3 | use Carp; 4 | 5 | my $port = 9999; 6 | 7 | socket(Server, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket: $!"; 8 | setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 9 | pack("l", 1)) || die "setsockopt: $!"; 10 | bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; 11 | listen(Server,SOMAXCONN) || die "listen: $!"; 12 | 13 | 14 | sub do_accept { 15 | accept(Client,Server); 16 | } 17 | sub run { 18 | do_accept; 19 | } 20 | 21 | warn "server started on $port"; 22 | run; 23 | warn "server ending on $port"; 24 | exit 0; 25 | -------------------------------------------------------------------------------- /devstuff/eval-fid-ordering.patch: -------------------------------------------------------------------------------- 1 | An experimental patch I wrote but never applied. May be useful in future. 2 | Probably worth applying, but needs a test case first. 3 | 4 | Index: NYTProf.xs 5 | =================================================================== 6 | --- NYTProf.xs (revision 1053) 7 | +++ NYTProf.xs (working copy) 8 | @@ -798,6 +798,7 @@ 9 | * filename, and associate that fid with this eval fid 10 | */ 11 | if ('(' == file_name[0]) { /* first char is '(' */ 12 | + int saved_next_fid = next_fid; 13 | if (']' == file_name[file_name_len-1]) { /* last char is ']' */ 14 | char *start = strchr(file_name, '['); 15 | const char *colon = ":"; 16 | @@ -810,6 +811,7 @@ 17 | } 18 | ++start; /* move past [ */ 19 | /* recurse */ 20 | + next_fid--; 21 | found->eval_fid = get_file_id(aTHX_ start, end - start, created_via); 22 | found->eval_line_num = atoi(end+1); 23 | } 24 | @@ -818,11 +820,22 @@ 25 | /* seen in mod_perl, possibly from eval_sv(sv) api call */ 26 | /* also when nameevals=0 option is in effect */ 27 | char eval_file[] = "/unknown-eval-invoker"; 28 | + next_fid--; 29 | found->eval_fid = get_file_id(aTHX_ eval_file, sizeof(eval_file) - 1, 30 | NYTP_FIDf_IS_FAKE | created_via 31 | ); 32 | found->eval_line_num = 1; 33 | } 34 | + /* if get_file_id allocated a new fid then, because of the next_fid-- above, 35 | + * it would have reused the same fid as found->id (and output it). 36 | + * So we now adopt ++next_fid as our found->id. 37 | + */ 38 | + if (next_fid != saved_next_fid)) { 39 | + found->id = ++next_fid; 40 | + } 41 | + else { 42 | + next_fid = saved_next_fid; 43 | + } 44 | } 45 | 46 | /* is the file is an autosplit, e.g., has a file_name like 47 | -------------------------------------------------------------------------------- /devstuff/example.pl: -------------------------------------------------------------------------------- 1 | 2 | 3 | require Ex01::Statements; 4 | require Ex01::Loops; 5 | require Ex01::Subs; 6 | require Ex01::Slowops; 7 | require Ex01::Subcall; 8 | -------------------------------------------------------------------------------- /devstuff/foo.pl: -------------------------------------------------------------------------------- 1 | sub{exit} 2 | -------------------------------------------------------------------------------- /devstuff/superseded.pm: -------------------------------------------------------------------------------- 1 | # 2021-03-31: packages_at_depth_subinfo() not found in distro 2 | # [ 3 | # undef, # depth 0 4 | # { # depth 1 5 | # "main::" => [ [ subinfo1, subinfo2 ] ], # 2 subs in 1 pkg 6 | # "Foo::" => [ [ subinfo3 ], [ subinfo4 ] ] # 2 subs in 2 pkg 7 | # } 8 | # { # depth 2 9 | # "Foo::Bar::" => [ [ subinfo3 ] ] # 1 sub in 1 pkg 10 | # "Foo::Baz::" => [ [ subinfo4 ] ] # 1 sub in 1 pkg 11 | # } 12 | # ] 13 | # 14 | sub packages_at_depth_subinfo { 15 | my $self = shift; 16 | my ($opts) = @_; 17 | 18 | my $merged = $opts->{merge_subinfos}; 19 | my $all_pkgs = $self->package_subinfo_map($merged) || {}; 20 | 21 | my @packages_at_depth = ({}); 22 | while ( my ($fullpkgname, $subinfos) = each %$all_pkgs ) { 23 | 24 | $subinfos = [ grep { $_->calls } @$subinfos ] 25 | if not $opts->{include_unused_subs}; 26 | 27 | next unless @$subinfos; 28 | 29 | my @parts = split /::/, $fullpkgname; # drops empty trailing part 30 | 31 | # accumulate @$subinfos for the full package name 32 | # and also for each successive truncation of the package name 33 | for (my $depth; $depth = @parts; pop @parts) { 34 | my $pkgname = join('::', @parts, ''); 35 | 36 | my $store = ($merged) ? $subinfos->[0] : $subinfos; 37 | 38 | # { "Foo::" => [ [sub1,sub2], [sub3,sub4] ] } # subs from 2 packages 39 | my $pkgdepthinfo = $packages_at_depth[$depth] ||= {}; 40 | push @{ $pkgdepthinfo->{$pkgname} }, $store; 41 | 42 | last if not $opts->{rollup_packages}; 43 | } 44 | } 45 | # fill in any undef holes at depths with no subs 46 | $_ ||= {} for @packages_at_depth; 47 | 48 | return \@packages_at_depth; 49 | } 50 | 51 | 52 | # 2021-03-31: package_fids() not exercised anywhere in distro 53 | sub package_fids { 54 | my ($self, $package) = @_; 55 | my @fids; 56 | #warn "package_fids '$package'"; 57 | return @fids if wantarray; 58 | warn "Package 'package' has items defined in multiple fids: @fids\n" 59 | if @fids > 1; 60 | return $fids[0]; 61 | } 62 | 63 | -------------------------------------------------------------------------------- /devstuff/superseded.xs: -------------------------------------------------------------------------------- 1 | /** 2 | * Return a unique persistent id number for a string. 3 | * 4 | * XXX Currently not used, so may trigger compiler warnings, but is intended to be 5 | * used to assign ids to strings like subroutine names like we do for file ids. 6 | */ 7 | static unsigned int 8 | get_str_id(pTHX_ char* str, STRLEN len) 9 | { 10 | str_hash_entry *found; 11 | hash_op(&strhash, str, len, (Hash_entry**)&found, 1); 12 | return found->he.id; 13 | } 14 | 15 | 16 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/Constants.pm: -------------------------------------------------------------------------------- 1 | package Devel::NYTProf::Constants; 2 | 3 | use strict; 4 | 5 | use Devel::NYTProf::Core; 6 | 7 | use base 'Exporter'; 8 | 9 | our @EXPORT_OK = qw(const_bits2names); 10 | 11 | my $const_bits2names_groups; 12 | 13 | do { 14 | my $symbol_table = do { no strict; \%{"Devel::NYTProf::Constants::"} }; 15 | my %consts = map { $_ => $symbol_table->{$_}() } grep { /^NYTP_/ } keys %$symbol_table; 16 | 17 | push @EXPORT_OK, keys %consts; 18 | 19 | for my $sym (keys %consts) { 20 | $sym =~ /^(NYTP_[A-Z]+[a-z])_/ or next; 21 | $const_bits2names_groups->{$1}{ $consts{$sym} } = $sym; 22 | } 23 | }; 24 | 25 | 26 | sub const_bits2names { # const_bits2names("NYTP_FIDf",$flags) 27 | my ($group, $bits) = @_; 28 | my $names = $const_bits2names_groups->{$group} or return; 29 | my @names; 30 | for my $bit (0..31) { 31 | my $bitval = 1 << $bit; 32 | push @names, $names->{$bitval} 33 | if $bits & $bitval; 34 | } 35 | return @names if wantarray; 36 | return join " | ", @names; 37 | } 38 | 39 | # warn scalar const_bits2names("NYTP_FIDf", NYTP_FIDf_SAVE_SRC|NYTP_FIDf_IS_PMC); 40 | 41 | 42 | #warn "Constants: ".join(" ", sort @EXPORT_OK); 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/FileHandle.pm: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | package Devel::NYTProf::FileHandle; 6 | 7 | # We have to jump through some hoops to load a second XS file from the same 8 | # shared object. 9 | 10 | require DynaLoader; 11 | require Devel::NYTProf::Core; 12 | 13 | my $c_name = 'boot_Devel__NYTProf__FileHandle'; 14 | my $c = DynaLoader::dl_find_symbol_anywhere($c_name); 15 | 16 | die "Can't locate '$c_name' in Devel::NYTProf shared object" unless $c; 17 | my $xs = DynaLoader::dl_install_xsub(__PACKAGE__ . '::bootstrap', $c, __FILE__); 18 | &$xs(__PACKAGE__, $Devel::NYTProf::Core::VERSION); 19 | 20 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/Run.pm: -------------------------------------------------------------------------------- 1 | package Devel::NYTProf::Run; 2 | 3 | # vim: ts=8 sw=4 expandtab: 4 | ########################################################## 5 | # This script is part of the Devel::NYTProf distribution 6 | # 7 | # Copyright, contact and other information can be found 8 | # at the bottom of this file, or by going to: 9 | # http://metacpan.org/release/Devel-NYTProf/ 10 | # 11 | ########################################################### 12 | 13 | =head1 NAME 14 | 15 | Devel::NYTProf::Run - Invoke NYTProf on a piece of code and return the profile 16 | 17 | =head1 DESCRIPTION 18 | 19 | This module is experimental and subject to change. 20 | 21 | =cut 22 | 23 | use warnings; 24 | use strict; 25 | 26 | use base qw(Exporter); 27 | 28 | use Carp; 29 | use Config qw(%Config); 30 | use Devel::NYTProf::Data; 31 | 32 | our @EXPORT_OK = qw( 33 | profile_this 34 | perl_command_words 35 | ); 36 | 37 | 38 | my $this_perl = $^X; 39 | $this_perl .= $Config{_exe} if $^O ne 'VMS' and $this_perl !~ m/$Config{_exe}$/i; 40 | 41 | 42 | sub perl_command_words { 43 | my %opt = @_; 44 | 45 | my @perl = ($this_perl); 46 | 47 | # testing just $Config{usesitecustomize} isn't reliable for perl 5.11.x 48 | if (($Config{usesitecustomize}||'') eq 'define' 49 | or $Config{ccflags} =~ /(?new may croak, e.g., if data truncated 61 | sub profile_this { 62 | my %opt = @_; 63 | 64 | my $out_file = $opt{out_file} || 'nytprof.out'; 65 | 66 | my @perl = (perl_command_words(%opt), '-d:NYTProf'); 67 | 68 | warn sprintf "profile_this() using %s with NYTPROF=%s\n", 69 | join(" ", @perl), $ENV{NYTPROF} || '' 70 | if $opt{verbose}; 71 | 72 | # ensure child has same libs as us (e.g., if we were run with perl -Mblib) 73 | local $ENV{PERL5LIB} = join($Config{path_sep}, @INC); 74 | 75 | if (my $src_file = $opt{src_file}) { 76 | system(@perl, $src_file) == 0 77 | or carp "Exit status $? from @perl $src_file"; 78 | } 79 | elsif (my $src_code = $opt{src_code}) { 80 | my $cmd = join ' ', map qq{"$_"}, @perl; 81 | open my $fh, "| $cmd" 82 | or croak "Can't open pipe to $cmd"; 83 | print $fh $src_code; 84 | close $fh 85 | or carp $! ? "Error closing $cmd pipe: $!" 86 | : "Exit status $? from $cmd"; 87 | 88 | } 89 | else { 90 | croak "Neither src_file or src_code was provided"; 91 | } 92 | 93 | # undocumented hack that's handy for testing 94 | if ($opt{htmlopen}) { 95 | my @nytprofhtml_open = ("perl", "nytprofhtml", "--open", "-file=$out_file"); 96 | warn "Running @nytprofhtml_open\n"; 97 | system @nytprofhtml_open; 98 | } 99 | 100 | my $profile = Devel::NYTProf::Data->new( { filename => $out_file } ); 101 | 102 | unlink $out_file; 103 | 104 | return $profile; 105 | } 106 | 107 | 1; 108 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/SubCallInfo.pm: -------------------------------------------------------------------------------- 1 | package Devel::NYTProf::SubCallInfo; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp; 6 | 7 | use Devel::NYTProf::Constants qw( 8 | NYTP_SCi_CALL_COUNT 9 | NYTP_SCi_INCL_RTIME NYTP_SCi_EXCL_RTIME NYTP_SCi_RECI_RTIME 10 | NYTP_SCi_REC_DEPTH NYTP_SCi_CALLING_SUB 11 | NYTP_SCi_elements 12 | ); 13 | 14 | sub calls { shift->[NYTP_SCi_CALL_COUNT] } 15 | 16 | sub incl_time { shift->[NYTP_SCi_INCL_RTIME] } 17 | 18 | sub excl_time { shift->[NYTP_SCi_EXCL_RTIME] } 19 | 20 | sub recur_max_depth { shift->[NYTP_SCi_REC_DEPTH] } 21 | 22 | sub recur_incl_time { shift->[NYTP_SCi_RECI_RTIME] } 23 | 24 | 25 | # vim:ts=8:sw=4:et 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/Test.pm: -------------------------------------------------------------------------------- 1 | package # hide from pause package indexer 2 | Devel::NYTProf::Test; 3 | 4 | # this module is just to test the test suite 5 | # see t/test60-subname.p for example 6 | 7 | require Devel::NYTProf::Core; 8 | require Exporter; 9 | our @ISA = qw(Exporter); 10 | 11 | our @EXPORT_OK = qw(example_sub example_xsub example_xsub_eval set_errno); 12 | 13 | sub example_sub { } 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/asc.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/asc.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/bg.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/bg.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/desc.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/desc.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/Treemap.css: -------------------------------------------------------------------------------- 1 | 2 | /* style for the visualization container */ 3 | #infovis { 4 | width:96%; 5 | height:600px; 6 | margin:auto; 7 | background-color: white; 8 | 9 | color:black; 10 | text-align:center; 11 | overflow:hidden; 12 | font-size:10px; 13 | font-family:Verdana, Geneva, Arial, Helvetica, sans-serif; 14 | } 15 | #infovis1 { position:relative; width:96%; height:600px; } 16 | #infovis2 { position:relative; width:96%; height:600px; } 17 | 18 | #infovis div { 19 | position:absolute; 20 | overflow:hidden; 21 | background-color: #666666; 22 | } 23 | 24 | #infovis1 div { 25 | position:absolute; 26 | overflow:hidden; 27 | background-color: #666666; 28 | } 29 | 30 | #infovis2 div { 31 | position:absolute; 32 | overflow:hidden; 33 | background-color: #666666; 34 | } 35 | 36 | /* 37 | * #666666 - dark grey for line 38 | * #dddddd - mid grey for header backgrounds 39 | * #cccccc - light grey for inter-sub borders 40 | */ 41 | 42 | #infovis .content { 43 | } 44 | #infovis .over-content { 45 | } 46 | 47 | #infovis .head { 48 | height:12px; 49 | color:black; 50 | font-weight:bold; 51 | background-color:#dddddd; 52 | } 53 | #infovis .over-head { 54 | background-color:#FFFF00; 55 | } 56 | #infovis .head.in-path { 57 | background-color:#FFFF00; 58 | } 59 | 60 | 61 | #infovis .leaf { 62 | display:table-cell; 63 | vertical-align:middle; 64 | background-color:white; 65 | border:solid 1px transparent; 66 | } 67 | #infovis .over-leaf { 68 | /* border:1px solid red; */ 69 | outline: 2px solid red; outline-offset: -2px; 70 | } 71 | 72 | 73 | /* tooltips style */ 74 | .tip { 75 | z-index: 13000; 76 | position:absolute; 77 | font-size:12px; 78 | font-family:Monaco, Andale Mono, monospace; 79 | color: white; 80 | background-color: black; 81 | opacity: 0.8; 82 | padding: 15px; 83 | border-radius: 5px; 84 | -webkit-border-radius: 5px; 85 | -moz-border-radius: 5px; 86 | -webkit-box-shadow: 5px 5px 5px rgba(0, 0, 0, 0.5); 87 | -moz-box-shadow: black 5px 5px 5px; 88 | } 89 | 90 | -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/gradient-cushion1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/jit/gradient-cushion1.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/gradient.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/jit/gradient.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/gradient20.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/jit/gradient20.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/gradient30.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/jit/gradient30.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/gradient40.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/jit/gradient40.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/jit/gradient50.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/lib/Devel/NYTProf/js/jit/gradient50.png -------------------------------------------------------------------------------- /lib/Devel/NYTProf/js/style-tablesorter.css: -------------------------------------------------------------------------------- 1 | /* tables */ 2 | table.tablesorter thead .tablesorter-header { 3 | /* background-image: url(bg.png); */ 4 | background-repeat: no-repeat; 5 | background-position: 0% 80%; 6 | cursor: pointer; 7 | } 8 | table.tablesorter thead th.tablesorter-headerAsc { background-image: url(asc.png); } 9 | table.tablesorter thead th.tablesorter-headerDesc { background-image: url(desc.png); } 10 | -------------------------------------------------------------------------------- /t/00-load.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 2; 4 | 5 | use Config; 6 | 7 | use_ok( 'Devel::NYTProf::Core' ); 8 | 9 | # we note the time in the test log here (the first test) and in t/zzz.t 10 | # so we can judge how fast the set of tests ran and this the rough speed of the system 11 | diag( "Testing Devel::NYTProf $Devel::NYTProf::Core::VERSION started at ".localtime(time) ); 12 | 13 | use_ok( 'Devel::NYTProf::Constants', qw( 14 | NYTP_DEFAULT_COMPRESSION NYTP_ZLIB_VERSION 15 | ) ); 16 | 17 | diag( sprintf "Compression: default level is %d, zlib version %s", 18 | NYTP_DEFAULT_COMPRESSION(), NYTP_ZLIB_VERSION() 19 | ); 20 | 21 | diag "--- Perl $] Config on $Config{archname}:"; 22 | diag "\t$_: ".(defined $Config{$_} ? $Config{$_} : '(undef)') 23 | for qw( 24 | d_gettimeod d_sysconf 25 | ); 26 | 27 | if ("$Config{archname} $Config{osvers}" =~ /\b xen \b/x 28 | or -d "/proc/xen" # maybe 29 | ) { 30 | diag("------------------------"); 31 | diag("--- Xen platform issues:"); 32 | diag("It looks like this is running inside a Xen virtual machine."); 33 | diag("Operating system clocks may appear to be unstable in this situation,"); 34 | diag("so tests may fail or produce odd warnings."); 35 | diag("See results from http://www.google.com/search?q=xen+clock+backwards"); 36 | diag("Including https://bugs.launchpad.net/xen/+bug/146924"); 37 | diag("And https://bugzilla.redhat.com/show_bug.cgi?id=449346"); 38 | diag("And http://rhn.redhat.com/errata/RHSA-2009-1243.html"); 39 | diag("In short, you may need to upgrade Xen and/or your OS."); 40 | diag("Note that use of NYTProf inside a virtual machine is likely to affect accuracy anyway."); 41 | diag("------------------------"); 42 | } 43 | 44 | my @env = grep { /^NYTPROF/ } sort keys %ENV; 45 | diag("--- Environment variables:") if @env; 46 | diag("\t$_=$ENV{$_}") for @env; 47 | -------------------------------------------------------------------------------- /t/10-run.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | use lib qw(t/lib); 6 | use NYTProfTest; 7 | 8 | # test run_test_group() with extra_test_code and profile_this() 9 | 10 | use Devel::NYTProf::Run qw(profile_this); 11 | 12 | # tiny amount of source code to exercise RT#50851 13 | my @src = ( 14 | "\$a = 1;\n", 15 | "\$b = 2;\n", 16 | ); 17 | 18 | run_test_group( { 19 | extra_options => { 20 | }, 21 | extra_test_count => 17, 22 | extra_test_code => sub { 23 | my ($profile, $env) = @_; 24 | 25 | $profile = profile_this( 26 | src_code => join('', @src), 27 | out_file => $env->{file}, 28 | skip_sitecustomize => 1, 29 | ); 30 | isa_ok $profile, 'Devel::NYTProf::Data'; 31 | 32 | my ($fi, @others) = $profile->all_fileinfos; 33 | is @others, 0, 'should be one fileinfo'; 34 | 35 | is $fi->fid, 1; 36 | is $fi->filename, '-'; # profile_this() does "| perl -" 37 | is $fi->abs_filename, '-'; 38 | is $fi->filename_without_inc, '-'; 39 | 40 | is $fi->eval_fi, undef; 41 | is $fi->eval_fid, ''; # PL_sv_no 42 | is $fi->eval_line, ''; # PL_sv_no 43 | is_deeply $fi->evals_by_line, {}; 44 | 45 | is $fi->profile, $profile; 46 | ok not $fi->is_eval; 47 | ok not $fi->is_fake; 48 | ok not $fi->is_pmc; 49 | 50 | my $line_time_data = $fi->line_time_data; 51 | is ref $line_time_data, 'ARRAY'; 52 | 53 | is $fi->sum_of_stmts_count, 2; 54 | 55 | # should be tiny (will be 0 on systems without a highres clock) 56 | cmp_ok $fi->sum_of_stmts_time, '<', 10; 57 | }, 58 | }); 59 | -------------------------------------------------------------------------------- /t/13-fileinfo.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Carp; 4 | use Config qw(%Config); 5 | use Devel::NYTProf::Data; 6 | use Test::More; 7 | use Devel::NYTProf::Constants qw( 8 | NYTP_DEFAULT_COMPRESSION 9 | NYTP_ZLIB_VERSION 10 | ); 11 | 12 | plan skip_all => "needs different profile data for testing on longdouble builds" 13 | if (defined $Config{uselongdouble} and $Config{uselongdouble} eq 'define'); 14 | 15 | plan skip_all => "needs different profile data for testing on quadmath builds" 16 | if (defined $Config{usequadmath} and $Config{usequadmath} eq 'define'); 17 | 18 | my $file = "./t/nytprof_13-data.out.txt"; 19 | croak "No $file" unless -f $file; 20 | 21 | plan skip_all => "$file doesn't work unless NYTP_ZLIB_VERSION is set" unless NYTP_ZLIB_VERSION(); 22 | 23 | # General setup 24 | 25 | my $profile = Devel::NYTProf::Data->new({ filename => $file, quiet => 1 }); 26 | ok(defined $profile, "Devel::NYTProf::Data->new() returned defined value"); 27 | 28 | my @all_fileinfos = $profile->all_fileinfos(); 29 | is(scalar(@all_fileinfos), 1, "got 1 all_fileinfo"); 30 | my $fi = $all_fileinfos[0]; 31 | isa_ok($fi, 'Devel::NYTProf::FileInfo'); 32 | 33 | # For filename(), filename_without_inc() and summary(), return value will 34 | # differ based on whether we're running from top-level directory (e.g., via 35 | # 'prove') or via test harness (e.g., via 'make test'). So, rather than 36 | # demand an exact match on the return value, we'll try to match the end of the 37 | # absolute path. 38 | 39 | my $expected_pattern = qr/t\/test01\.p$/; 40 | like($fi->filename, $expected_pattern, 41 | "Got expected pattern for filename"); 42 | like($fi->filename_without_inc, $expected_pattern, 43 | "Got expected pattern for filename without inc"); 44 | like($fi->summary, $expected_pattern, 45 | "Got expected pattern for summary"); 46 | 47 | my $expected_fid = 1; 48 | is($fi->fid, $expected_fid, "Got expected fid"); 49 | is($fi->size, 0, "Got expected file size"); 50 | is($fi->mtime, 0, "Got expected file mtime"); 51 | isa_ok($fi->profile, 'Devel::NYTProf::Data'); 52 | is($fi->flags, 18, "Got expected flags"); 53 | ok($fi->is_file, "We're dealing with a file"); 54 | 55 | my $et = $fi->excl_time(); 56 | cmp_ok($et, '>', 0, "Got positive excl time: $et"); 57 | 58 | ok(! $fi->eval_fid, "Not an eval fid"); 59 | ok(! $fi->eval_line, "Hence, no eval line"); 60 | ok(!$fi->is_eval, "We're not dealing with a simple eval"); 61 | ok(! defined $fi->outer(), "outer() returns undefined value because no eval fid"); 62 | ok(! defined $fi->sibling_evals, "sibling_evals() returns undefined value because no eval fid"); 63 | 64 | my @subs_defined = $fi->subs_defined(); 65 | isa_ok($subs_defined[0], 'Devel::NYTProf::SubInfo'); 66 | 67 | my @subs_defined_sorted = $fi->subs_defined_sorted(); 68 | isa_ok($subs_defined_sorted[0], 'Devel::NYTProf::SubInfo'); 69 | 70 | # TODO XXX: Test an eval fid 71 | 72 | done_testing(); 73 | -------------------------------------------------------------------------------- /t/14-subinfo.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Carp; 4 | use Config qw(%Config); 5 | use Devel::NYTProf::Reader; 6 | use Test::More; 7 | use Devel::NYTProf::Constants qw( 8 | NYTP_DEFAULT_COMPRESSION 9 | NYTP_ZLIB_VERSION 10 | ); 11 | 12 | plan skip_all => "needs different profile data for testing on longdouble builds" 13 | if (defined $Config{uselongdouble} and $Config{uselongdouble} eq 'define'); 14 | 15 | plan skip_all => "needs different profile data for testing on quadmath builds" 16 | if (defined $Config{usequadmath} and $Config{usequadmath} eq 'define'); 17 | 18 | my $file = "./t/nytprof_14-subinfo.out.txt"; 19 | croak "No $file" unless -f $file; 20 | 21 | plan skip_all => "$file doesn't work unless NYTP_ZLIB_VERSION is set" unless NYTP_ZLIB_VERSION(); 22 | 23 | # General setup 24 | 25 | my $reporter = Devel::NYTProf::Reader->new($file, { quiet => 1 }); 26 | ok(defined $reporter, "Devel::NYTProf::Reader->new returned defined entity"); 27 | isa_ok($reporter, 'Devel::NYTProf::Reader'); 28 | 29 | my $profile = $reporter->{profile}; 30 | isa_ok($profile, 'Devel::NYTProf::Data'); 31 | 32 | my ($pkgref, $subinfo_obj, @keys, $expect); 33 | 34 | $pkgref = $profile->package_subinfo_map(0,1); 35 | is(ref($pkgref), 'HASH', 36 | "Devel::NYTProf::Data->package_subinfo_map(0,1) returned hashref"); 37 | @keys = keys %{$pkgref}; 38 | is(@keys, 1, "1-element hash"); 39 | $expect = 'main'; 40 | is($keys[0], $expect, "Sole element is '$expect'"); 41 | isa_ok($pkgref->{$expect}{""}[0], 'Devel::NYTProf::SubInfo'); 42 | $subinfo_obj = $pkgref->{$expect}{""}[0]; 43 | isa_ok($subinfo_obj, 'Devel::NYTProf::SubInfo'); 44 | 45 | ## Covered, but not explicitly: 46 | ## recur_max_depth 47 | ## recur_incl_time 48 | ## cache 49 | 50 | $expect = 1; 51 | is($subinfo_obj->fid, $expect, "Got expected fid"); 52 | 53 | my ($fl, 54 | $ll, $calls); 55 | 56 | $fl = $subinfo_obj->first_line; 57 | ok(($fl =~ m/^\d+/ and $fl >= 0), "first_line() returned non-negative integer"); 58 | $ll = $subinfo_obj->last_line; 59 | ok(($ll =~ m/^\d+/ and $fl >= 0), "last_line() returned non-negative integer"); 60 | $calls = $subinfo_obj->calls; 61 | ok(($calls =~ m/^\d+/ and $fl >= 0), "calls() returned non-negative integer"); 62 | 63 | my ($subname, $package, $without); 64 | $subname = $subinfo_obj->subname; 65 | ($package, $without) = split '::', $subname, 2; 66 | is($package, 'main', "subname() returned expected package"); 67 | is($subinfo_obj->subname_without_package, $without, 68 | "subname_without_package() returned expected name"); 69 | is($subinfo_obj->package, $package, 70 | "package() returned expected package"); 71 | 72 | $profile = $subinfo_obj->profile; 73 | is(ref($profile), 'Devel::NYTProf::Data', 74 | "profile() returns Devel::NYTProf::Data object"); 75 | 76 | ok(defined($subinfo_obj->incl_time), "incl_time() returned defined value"); 77 | ok(defined($subinfo_obj->excl_time), "excl_time() returned defined value"); 78 | ok(defined($subinfo_obj->recur_max_depth), "recur_max_depth() returned defined value"); 79 | ok(defined($subinfo_obj->recur_incl_time), "recur_incl_time() returned defined value"); 80 | is(ref($subinfo_obj->cache), 'HASH', "cache() returned hash ref"); 81 | 82 | my @caller_places = $subinfo_obj->caller_places; 83 | for my $c (@caller_places) { 84 | is(ref($c), 'ARRAY', 85 | "each element of any returned by caller_places() is an array ref"); 86 | } 87 | is($subinfo_obj->caller_count, scalar(@caller_places), 88 | "caller_count() returned expected count"); 89 | 90 | my $fileinfo = $subinfo_obj->fileinfo; 91 | isa_ok($fileinfo, 'Devel::NYTProf::FileInfo'); 92 | 93 | done_testing(); 94 | -------------------------------------------------------------------------------- /t/22-readstream.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | use Config; 6 | use Data::Dumper; 7 | 8 | use lib qw(t/lib); 9 | use NYTProfTest; 10 | 11 | use Devel::NYTProf::ReadStream qw(for_chunks); 12 | 13 | my $pre589 = ($] < 5.008009 or $] eq "5.010000"); 14 | 15 | (my $base = __FILE__) =~ s/\.t$//; 16 | 17 | # generate an nytprof out file 18 | my $out = 'nytprof_readstream.out'; 19 | $ENV{NYTPROF} = "calls=2:blocks=1:file=$out"; 20 | unlink $out; 21 | 22 | run_perl_command(qq{-d:NYTProf -e "sub A { };" -e "1;" -e "A() $Devel::NYTProf::StrEvalTestPad"}); 23 | 24 | my %prof; 25 | my @seqn; 26 | 27 | for_chunks { 28 | push @seqn, "$."; 29 | my $tag = shift; 30 | push @{ $prof{$tag} }, [ @_ ]; 31 | if (1) { 32 | my @params = @_; 33 | not defined $_ and $_ = '(undef)' for @params; 34 | chomp @params; 35 | print "# $. $tag @params\n"; 36 | } 37 | } filename => $out; 38 | 39 | my %option = map { @$_ } @{$prof{OPTION}}; 40 | cmp_ok scalar keys %option, '>=', 17, 'enough options'; 41 | 42 | my %attribute = map { @$_ } @{$prof{ATTRIBUTE}}; 43 | cmp_ok scalar keys %attribute, '>=', 9, 'enough attribute'; 44 | 45 | ok scalar @seqn, 'should have read chunks'; 46 | is_deeply(\@seqn, [0..@seqn-1], "chunk seq"); 47 | 48 | is_deeply $prof{VERSION}, [ [ 5, 0 ] ]; 49 | 50 | # check for expected tags 51 | # but not START_DEFLATE as that'll be missing if there's no zlib 52 | # and not SRC_LINE as old perl's 53 | my @expected_tags = qw( 54 | COMMENT ATTRIBUTE OPTION DISCOUNT 55 | SUB_INFO SUB_CALLERS 56 | PID_START PID_END NEW_FID 57 | SUB_ENTRY SUB_RETURN 58 | ); 59 | push @expected_tags, 'TIME_BLOCK' if $option{calls}; 60 | for my $tag (@expected_tags) { 61 | is ref $prof{$tag}[0], 'ARRAY', "raw $tag array seen" 62 | or diag Dumper $prof{$tag}; 63 | } 64 | 65 | SKIP: { 66 | skip 'needs perl >= 5.8.9 or >= 5.10.1', 1 if $pre589; 67 | is ref $prof{SRC_LINE}[0], 'ARRAY', 'SRC_LINE'; 68 | } 69 | 70 | # check some attributes 71 | my %attr = map { $_->[0] => $_->[1] } @{ $prof{ATTRIBUTE} }; 72 | cmp_ok $attr{ticks_per_sec}, '>=', 1_000_000, 'ticks_per_sec'; 73 | is $attr{application}, '-e', 'application'; 74 | is $attr{nv_size}, $Config{nvsize}, 'nv_size'; 75 | { 76 | no warnings 'numeric'; 77 | cmp_ok $attr{xs_version}, '>=', 2.1, 'xs_version'; 78 | } 79 | cmp_ok $attr{basetime}, '>=', $^T, 'basetime'; 80 | 81 | my @sub_info_sorted = sort { $a->[3] cmp $b->[3] } @{$prof{SUB_INFO}}; 82 | is_deeply \@sub_info_sorted, [ 83 | [1, 1, 1, "main::A"], 84 | [1, 0, 0, "main::BEGIN"], 85 | [1, 1, 1, "main::RUNTIME"], 86 | ]; 87 | 88 | $prof{SUB_CALLERS}[0][$_] = 0 for (3,4); 89 | is_deeply $prof{SUB_CALLERS}, [ 90 | [ 1, 3, 1, 0, 0, '0', 0, 'main::A', 'main::RUNTIME' ] 91 | ]; 92 | 93 | is_deeply $prof{SUB_ENTRY}, [ [ 1, 3 ] ], 'SUB_ENTRY args'; 94 | 95 | $prof{SUB_RETURN}[0][$_] = 0 for (1,2); 96 | is_deeply $prof{SUB_RETURN}, [ [ 1, 0, 0, 'main::A' ] ], 'SUB_RETURN args'; 97 | 98 | done_testing(); 99 | -------------------------------------------------------------------------------- /t/31-env.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | require XSLoader; 5 | 6 | # Disable "once" warnings 7 | BEGIN { 8 | my $ok = eval { require warnings; 1 }; 9 | if ( $ok ) { 10 | warnings->unimport( qw( once redefine ) ); 11 | } 12 | else { 13 | $^W = 0; 14 | } 15 | } 16 | 17 | my @tests = ( 18 | [ 'start=no:file=nytprof.out' => { start => 'no', file => 'nytprof.out' } ], 19 | [ 'start=no:file=nytprof\:out' => { start => 'no', file => 'nytprof:out' } ], 20 | [ 'start=no:file=nytprof\=out' => { start => 'no', file => 'nytprof=out' } ], 21 | ); 22 | 23 | plan( tests => 1 * @tests ); 24 | for my $test ( @tests ) { 25 | my ( $nytprof, $expected ) = @$test; 26 | 27 | # Abrogate the XSLoader used to load the XS function DB::set_option. 28 | local *XSLoader::load = sub {}; 29 | 30 | # Hook the function used to set options to capture it's parsing. 31 | my %got; 32 | local *DB::set_option = sub { 33 | my ( $k, $v ) = @_; 34 | $got{$k} = $v; 35 | }; 36 | 37 | # (pretend to) Unload the class. 38 | delete $INC{'Devel/NYTProf/Core.pm'}; 39 | 40 | # Test the class's parsing. 41 | local $ENV{NYTPROF} = $nytprof; 42 | require Devel::NYTProf::Core; 43 | is_deeply( \%got, $expected, "Parsed \$ENV{NYTPROF}='$nytprof' ok" ); 44 | } 45 | 46 | -------------------------------------------------------------------------------- /t/40-savesrc.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | use lib qw(t/lib); 6 | use NYTProfTest; 7 | 8 | plan skip_all => "needs perl >= 5.8.9 or >= 5.10.1" 9 | if $] < 5.008009 or $] eq "5.010000"; 10 | 11 | use Devel::NYTProf::Run qw(profile_this); 12 | 13 | run_test_group( { 14 | extra_test_count => 8, 15 | extra_test_code => sub { 16 | my ($profile, $env) = @_; 17 | 18 | my $src_eval = "foo()"; 19 | my $src_code = "sub foo { } foo(); eval '$src_eval'; "; 20 | $profile = profile_this( 21 | src_code => $src_code, 22 | out_file => $env->{file}, 23 | skip_sitecustomize => 1, 24 | ); 25 | isa_ok $profile, 'Devel::NYTProf::Data'; 26 | 27 | my @fi = $profile->all_fileinfos; 28 | is scalar @fi, 2, 'should have one fileinfo'; 29 | #printf "# %s\n", $_->filename for @fi; 30 | 31 | my $fi_s = $profile->fileinfo_of('-'); 32 | isa_ok $fi_s, 'Devel::NYTProf::FileInfo', 'should have fileinfo for "-"'; 33 | 34 | if ($env->{savesrc}) { 35 | my $lines_s = $fi_s->srclines_array; 36 | isa_ok $lines_s, 'ARRAY', 'srclines_array should return an array ref'; 37 | is $lines_s->[0], $src_code, 'source code line should match'; 38 | } 39 | else { pass() for 1..2 } 40 | 41 | # Strawberry perl portable has eval ID '(eval 5)[-:1]', 42 | # others have '(eval 0)[-:1]'. 43 | # Assume that, if we get two fileinfos then second is what we wanted. 44 | # Possibly should check if we match /\(eval [15]\)\[-:1\]/. 45 | my @file_infos = $profile->all_fileinfos; 46 | is (scalar @file_infos, 2, 'Got two file infos'); 47 | my $target_eval_name = $file_infos[-1]->filename; 48 | 49 | my $fi_e = $profile->fileinfo_of($target_eval_name); 50 | isa_ok $fi_e, 'Devel::NYTProf::FileInfo', 51 | 'should have fileinfo for "$target_eval_name"' 52 | or do { 53 | diag "Have fileinfo for: '$_'" 54 | for sort map { $_->filename } $profile->all_fileinfos; 55 | }; 56 | 57 | if ($env->{savesrc} && $fi_e) { 58 | my $lines_e = $fi_e->srclines_array; 59 | # perl adds a newline to eval strings 60 | is $lines_e->[0], "$src_eval\n", 'source code line should match'; 61 | #warn "@$lines_e"; 62 | } 63 | else { 64 | pass() for 1; 65 | } 66 | }, 67 | }); 68 | -------------------------------------------------------------------------------- /t/42-global.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests CORE::GLOBAL::foo plus assorted data model methods 4 | 5 | use Test::More; 6 | use lib '/home/travis/perl5'; # travis workaround https://travis-ci.org/timbunce/devel-nytprof/jobs/35285944 7 | use Test::Differences; 8 | 9 | use lib qw(t/lib); 10 | use NYTProfTest; 11 | 12 | use Devel::NYTProf::Run qw(profile_this); 13 | 14 | my $pre589 = ($] < 5.008009 or $] eq "5.010000"); 15 | 16 | my $src_code = join("", ); 17 | 18 | run_test_group( { 19 | extra_options => { start => 'begin' }, 20 | extra_test_count => 17, 21 | extra_test_code => sub { 22 | my ($profile, $env) = @_; 23 | 24 | $profile = profile_this( 25 | src_code => $src_code, 26 | out_file => $env->{file}, 27 | skip_sitecustomize => 1, 28 | ); 29 | isa_ok $profile, 'Devel::NYTProf::Data'; 30 | 31 | my $subs1 = $profile->subname_subinfo_map; 32 | 33 | my $begin = ($pre589) ? 'main::BEGIN' : 'main::BEGIN@4'; 34 | ok $subs1->{$begin}; 35 | ok $subs1->{'main::RUNTIME'}; 36 | ok $subs1->{'main::foo'}; 37 | 38 | my @fi = $profile->all_fileinfos; 39 | is @fi, 1, 'should be 1 fileinfo'; 40 | my $fid = $fi[0]->fid; 41 | 42 | my @a; # ($file, $fid, $first, $last); 43 | @a = $profile->file_line_range_of_sub($begin); 44 | is "$a[1] $a[2] $a[3]", "$fid 4 7", "details for $begin should match"; 45 | @a = $profile->file_line_range_of_sub('main::RUNTIME'); 46 | is "$a[1] $a[2] $a[3]", "$fid 1 1", 'details for main::RUNTIME should match'; 47 | @a = $profile->file_line_range_of_sub('main::foo'); 48 | is "$a[1] $a[2] $a[3]", "$fid 2 2", 'details for main::foo should match'; 49 | 50 | my $subs2 = $profile->subs_defined_in_file($fid); 51 | 52 | eq_or_diff [ sort keys %$subs2 ], [ sort keys %$subs1 ], 53 | 'keys from subname_subinfo_map and subs_defined_in_file should match'; 54 | 55 | my @begins = grep { $_->subname =~ /\bBEGIN\b/ } values %$subs2; 56 | if ($pre589) { # we only see one sub and we don't see it called 57 | is @begins, 1, 'number of BEGIN subs'; 58 | is grep({ $_->calls == 1 } @begins), 0, 'BEGIN has no calls'; 59 | } 60 | else { 61 | is @begins, 3, 'number of BEGIN subs'; 62 | is grep({ $_->calls == 1 } @begins), scalar @begins, 63 | 'all BEGINs should be called just once'; 64 | } 65 | 66 | my $sub; 67 | ok $sub = $subs2->{'main::RUNTIME'}; 68 | is $sub->calls, 0, 'main::RUNTIME should be called 0 times'; 69 | ok $sub = $subs2->{'main::foo'}; 70 | is $sub->calls, 2, 'main::foo should be called 2 times'; 71 | 72 | ok my $called_by_subnames = $sub->called_by_subnames; 73 | is keys %$called_by_subnames, 2, 'should be called from 2 subs'; 74 | 75 | }, 76 | }); 77 | 78 | __DATA__ 79 | #!perl 80 | sub foo { 42 } 81 | BEGIN { 'b' } BEGIN { 'c' } # two on same line 82 | BEGIN { # BEGIN@3 83 | foo(2); 84 | *CORE::GLOBAL::sleep = \&foo; 85 | } 86 | sleep 1; 87 | 88 | -------------------------------------------------------------------------------- /t/44-model.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests assorted data model methods 4 | 5 | use Test::More; 6 | 7 | use lib qw(t/lib); 8 | use NYTProfTest; 9 | 10 | use Devel::NYTProf::Run qw(profile_this); 11 | 12 | run_test_group( { 13 | extra_options => { start => 'begin' }, 14 | extra_test_count => 2, 15 | extra_test_code => sub { 16 | my ($profile, $env) = @_; 17 | 18 | my $src_code = q{ 19 | use strict 0.01; 20 | }; 21 | $profile = profile_this( 22 | src_code => $src_code, 23 | out_file => $env->{file}, 24 | skip_sitecustomize => 1, 25 | ); 26 | isa_ok $profile, 'Devel::NYTProf::Data'; 27 | 28 | my $subs = $profile->subname_subinfo_map; 29 | my ($filename, $fid, $first, $last) = $profile->file_line_range_of_sub("UNIVERSAL::VERSION"); 30 | is "$first-$last", "0-0", 'UNIVERSAL::VERSION line range'; 31 | 32 | }, 33 | }); 34 | -------------------------------------------------------------------------------- /t/50-errno.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | my $nytprof_out; 6 | BEGIN { 7 | $nytprof_out = "t/nytprof-50-errno.out"; 8 | $ENV{NYTPROF} = "start=init:file=$nytprof_out"; 9 | unlink $nytprof_out; 10 | } 11 | 12 | use Devel::NYTProf::Test qw(example_xsub example_sub set_errno); 13 | 14 | BEGIN { # https://rt.cpan.org/Ticket/Display.html?id=55049 15 | $! = 1; # set errno via perl 16 | set_errno(2); # set errno via C-code in NYTProf.xs 17 | return if $! == 2; # all is well 18 | plan skip_all => "Can't control errno in this perl build (linked with different CRT than perl?)"; 19 | } 20 | 21 | plan tests => 8; 22 | 23 | use Devel::NYTProf; 24 | 25 | # We set errno to some particular non-zero value to see if NYTProf changes it 26 | # (on many unix-like systems 3 is ESRCH 'No such process') 27 | my $dflterrno = 3; 28 | 29 | # simple assignment and immediate check of $! 30 | $! = $dflterrno; 31 | is 0+$!, $dflterrno, '$! should not be altered by NYTProf'; 32 | 33 | my $size1 = -s $nytprof_out; 34 | ok defined $size1, "$nytprof_out should at least exist" 35 | or die "Can't continue: $!"; 36 | 37 | SKIP: { 38 | skip 'On VMS buffer is not flushed', 1 if ($^O eq 'VMS'); 39 | cmp_ok $size1, '>', 0, "$nytprof_out should not be empty"; 40 | } 41 | 42 | $! = $dflterrno; 43 | example_sub(); 44 | is 0+$!, $dflterrno, "\$! should not be altered by assigning fids to previously unprofiled modules ($!)"; 45 | 46 | $! = $dflterrno; 47 | example_xsub(); 48 | is 0+$!, $dflterrno, "\$! should not be altered by assigning fids to previously unprofiled modules ($!)"; 49 | 50 | SKIP: { 51 | skip 'On VMS buffer does not flush', 1 if($^O eq 'VMS'); 52 | 53 | $! = $dflterrno; 54 | while (-s $nytprof_out == $size1) { 55 | # execute lots of statements to force some i/o even if zipping 56 | busy(); 57 | } 58 | is 0+$!, $dflterrno, '$! should not be altered by NYTProf i/o'; 59 | } 60 | 61 | ok not eval { example_xsub(0, "die"); 1; }; 62 | like $@, qr/^example_xsub\(die\)/; 63 | 64 | exit 0; 65 | 66 | sub busy { 67 | # none of this should alter $! 68 | for (my $i = 1_000; $i > 0; --$i) { 69 | example_xsub(); 70 | next if $i % 100; 71 | example_sub(); 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /t/60-forkdepth.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | use lib qw(t/lib); 6 | use NYTProfTest; 7 | 8 | plan skip_all => "doesn't work with fork() emulation" if (($^O eq "MSWin32") || ($^O eq 'VMS')); 9 | 10 | plan tests => 5; 11 | 12 | my $out = 'nytprof-forkdepth.out'; 13 | 14 | is run_forkdepth( 0 ), 1; 15 | is run_forkdepth( 1 ), 2; 16 | is run_forkdepth( 2 ), 3; 17 | is run_forkdepth( -1 ), 3; 18 | is run_forkdepth( undef), 3; 19 | 20 | exit 0; 21 | 22 | sub run_forkdepth { 23 | my ($forkdepth) = @_; 24 | printf "run_forkdepth %s\n", defined($forkdepth) ? $forkdepth : "undef"; 25 | 26 | unlink $_ for glob("$out.*"); 27 | 28 | $ENV{NYTPROF} = "file=$out:addpid=1:trace=0"; 29 | $ENV{NYTPROF} .= ":forkdepth=$forkdepth" if defined $forkdepth; 30 | 31 | my $forkdepth_cmd = q{-d:NYTProf -e "sub f { fork or return; wait; exit \$? } f; f; exit 0"}; 32 | run_perl_command($forkdepth_cmd); 33 | 34 | my @files = glob("$out.*"); 35 | unlink $_ for @files; 36 | 37 | return scalar @files; 38 | } 39 | 40 | -------------------------------------------------------------------------------- /t/70-subname.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests CORE::GLOBAL::foo plus assorted data model methods 4 | 5 | use Test::More; 6 | 7 | use lib qw(t/lib); 8 | use NYTProfTest; 9 | 10 | eval "use Sub::Name 0.11; 1" 11 | or plan skip_all => "Sub::Name 0.11 or later required"; 12 | 13 | print "Sub::Name $Sub::Name::VERSION $INC{'Sub/Name.pm'}\n"; 14 | 15 | use Devel::NYTProf::Run qw(profile_this); 16 | 17 | my $src_code = join("", ); 18 | 19 | run_test_group( { 20 | extra_options => { 21 | start => 'init', compress => 1, leave => 0, stmts => 0, slowops => 0, 22 | }, 23 | extra_test_count => 6, 24 | extra_test_code => sub { 25 | my ($profile, $env) = @_; 26 | 27 | $profile = profile_this( 28 | src_code => $src_code, 29 | out_file => $env->{file}, 30 | skip_sitecustomize => 1, 31 | #htmlopen => 1, 32 | ); 33 | isa_ok $profile, 'Devel::NYTProf::Data'; 34 | 35 | my $subs = $profile->subname_subinfo_map; 36 | 37 | my $sub = $subs->{'main::named'}; 38 | ok $sub; 39 | is $sub->calls, 1; 40 | is $sub->subname, 'main::named'; 41 | 42 | SKIP: { 43 | skip "Sub::Name 0.06 required for subname line numbers", 2 44 | if $Sub::Name::VERSION <= 0.06; 45 | is $sub->first_line, 3; 46 | is $sub->last_line, 3; 47 | } 48 | }, 49 | }); 50 | 51 | __DATA__ 52 | #!perl 53 | use Sub::Name; 54 | (subname 'named' => sub { print "sub called\n" })->(); 55 | 56 | my $longname = "sub34567890" x 10 x 4; 57 | (subname $longname => sub { print "sub called\n" })->(); 58 | 59 | my $deepname = "sub345678::" x 10 x 4; 60 | (subname $deepname => sub { print "sub called\n" })->(); 61 | -------------------------------------------------------------------------------- /t/80-version.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 4; 4 | 5 | use_ok('Devel::NYTProf::Core'); 6 | my $version = $Devel::NYTProf::Core::VERSION; 7 | ok $version, 'lib/Devel/NYTProf/Core.pm $VERSION should be set'; 8 | 9 | use_ok('Devel::NYTProf'); 10 | is $Devel::NYTProf::VERSION, $version, 'lib/Devel/NYTProf.pm $VERSION should match'; 11 | 12 | # clean up after ourselves 13 | DB::finish_profile(); 14 | unlink 'nytprof.out'; 15 | -------------------------------------------------------------------------------- /t/90-pod.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | 3 | use Test::More; 4 | unless ($ENV{NYTPROF_AUTHOR_TESTING}) { 5 | plan skip_all => "NYTPROF_AUTHOR_TESTING only"; 6 | } 7 | else { 8 | diag("Relevant envvar is true; proceeding to testing POD"); 9 | } 10 | 11 | eval "use Test::Pod 1.00"; 12 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 13 | 14 | all_pod_files_ok(); 15 | 16 | 1; 17 | -------------------------------------------------------------------------------- /t/nytprof_11-reader.out.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/nytprof_11-reader.out.txt -------------------------------------------------------------------------------- /t/nytprof_12-data.out.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/nytprof_12-data.out.txt -------------------------------------------------------------------------------- /t/nytprof_13-data.out.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/nytprof_13-data.out.txt -------------------------------------------------------------------------------- /t/nytprof_14-subinfo.out.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/nytprof_14-subinfo.out.txt -------------------------------------------------------------------------------- /t/test01.calls: -------------------------------------------------------------------------------- 1 | main::bar 1 2 | main::bar;main::CORE:print 1 3 | main::foo 1 4 | main::foo;main::CORE:print 1 5 | main::foo;main::bar 1 6 | main::foo;main::bar;main::CORE:print 1 7 | main::baz 1 8 | main::baz;main::CORE:print 1 9 | main::baz;main::bar 1 10 | main::baz;main::bar;main::CORE:print 1 11 | main::baz;main::foo 1 12 | main::baz;main::foo;main::CORE:print 1 13 | main::baz;main::foo;main::bar 1 14 | main::baz;main::foo;main::bar;main::CORE:print 1 15 | -------------------------------------------------------------------------------- /t/test01.p: -------------------------------------------------------------------------------- 1 | sub foo { 2 | print "in sub foo\n"; 3 | bar(); 4 | } 5 | 6 | sub bar { 7 | print "in sub bar\n"; 8 | } 9 | 10 | sub baz { 11 | print "in sub baz\n"; 12 | bar(); 13 | foo(); 14 | } 15 | 16 | bar(); 17 | baz(); 18 | foo(); 19 | -------------------------------------------------------------------------------- /t/test01.rdt: -------------------------------------------------------------------------------- 1 | attribute application test01.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 4 ] 18 | fid_block_time 1 7 [ 0 4 ] 19 | fid_block_time 1 11 [ 0 3 ] 20 | fid_block_time 1 16 [ 0 1 ] 21 | fid_block_time 1 17 [ 0 1 ] 22 | fid_block_time 1 18 [ 0 1 ] 23 | fid_fileinfo 1 [ test01.p 1 2 0 0 ] 24 | fid_fileinfo 1 sub main::BEGIN 0-0 25 | fid_fileinfo 1 sub main::CORE:print 0-0 26 | fid_fileinfo 1 sub main::RUNTIME 1-1 27 | fid_fileinfo 1 sub main::bar 6-8 28 | fid_fileinfo 1 sub main::baz 10-14 29 | fid_fileinfo 1 sub main::foo 1-4 30 | fid_fileinfo 1 call 2 main::CORE:print [ 2 0 0 0 0 0 0 main::foo ] 31 | fid_fileinfo 1 call 3 main::bar [ 2 0 0 0 0 0 0 main::foo ] 32 | fid_fileinfo 1 call 7 main::CORE:print [ 4 0 0 0 0 0 0 main::bar ] 33 | fid_fileinfo 1 call 11 main::CORE:print [ 1 0 0 0 0 0 0 main::baz ] 34 | fid_fileinfo 1 call 12 main::bar [ 1 0 0 0 0 0 0 main::baz ] 35 | fid_fileinfo 1 call 13 main::foo [ 1 0 0 0 0 0 0 main::baz ] 36 | fid_fileinfo 1 call 16 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 37 | fid_fileinfo 1 call 17 main::baz [ 1 0 0 0 0 0 0 main::RUNTIME ] 38 | fid_fileinfo 1 call 18 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 39 | fid_line_time 1 2 [ 0 2 ] 40 | fid_line_time 1 3 [ 0 2 ] 41 | fid_line_time 1 7 [ 0 4 ] 42 | fid_line_time 1 11 [ 0 1 ] 43 | fid_line_time 1 12 [ 0 1 ] 44 | fid_line_time 1 13 [ 0 1 ] 45 | fid_line_time 1 16 [ 0 1 ] 46 | fid_line_time 1 17 [ 0 1 ] 47 | fid_line_time 1 18 [ 0 1 ] 48 | fid_sub_time 1 2 [ 0 4 ] 49 | fid_sub_time 1 7 [ 0 4 ] 50 | fid_sub_time 1 11 [ 0 3 ] 51 | fid_sub_time 1 16 [ 0 1 ] 52 | fid_sub_time 1 17 [ 0 1 ] 53 | fid_sub_time 1 18 [ 0 1 ] 54 | profile_modes fid_block_time block 55 | profile_modes fid_line_time line 56 | profile_modes fid_sub_time sub 57 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 58 | sub_subinfo main::CORE:print [ 1:0-0 calls 7 times 0 0 0 0 ] 59 | sub_subinfo main::CORE:print called_by 1:2 [ 2 0 0 0 0 0 0 main::foo ] 60 | sub_subinfo main::CORE:print called_by 1:7 [ 4 0 0 0 0 0 0 main::bar ] 61 | sub_subinfo main::CORE:print called_by 1:11 [ 1 0 0 0 0 0 0 main::baz ] 62 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 63 | sub_subinfo main::bar [ 1:6-8 calls 4 times 0 0 0 0 ] 64 | sub_subinfo main::bar called_by 1:3 [ 2 0 0 0 0 0 0 main::foo ] 65 | sub_subinfo main::bar called_by 1:12 [ 1 0 0 0 0 0 0 main::baz ] 66 | sub_subinfo main::bar called_by 1:16 [ 1 0 0 0 0 0 0 main::RUNTIME ] 67 | sub_subinfo main::baz [ 1:10-14 calls 1 times 0 0 0 0 ] 68 | sub_subinfo main::baz called_by 1:17 [ 1 0 0 0 0 0 0 main::RUNTIME ] 69 | sub_subinfo main::foo [ 1:1-4 calls 2 times 0 0 0 0 ] 70 | sub_subinfo main::foo called_by 1:13 [ 1 0 0 0 0 0 0 main::baz ] 71 | sub_subinfo main::foo called_by 1:18 [ 1 0 0 0 0 0 0 main::RUNTIME ] 72 | -------------------------------------------------------------------------------- /t/test01.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group({ 8 | extra_test_count => 1, 9 | extra_test_code => sub { 10 | my ($profile, $env) = @_; 11 | isa_ok($profile, 'Devel::NYTProf::Data'); 12 | }, 13 | }); 14 | -------------------------------------------------------------------------------- /t/test01.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,sub foo { 5 | 0,2,0,print "in sub foo\n"; 6 | 0,2,0,bar(); 7 | 0,0,0,} 8 | 0,0,0, 9 | 0,0,0,sub bar { 10 | 0,4,0,print "in sub bar\n"; 11 | 0,0,0,} 12 | 0,0,0, 13 | 0,0,0,sub baz { 14 | 0,1,0,print "in sub baz\n"; 15 | 0,1,0,bar(); 16 | 0,1,0,foo(); 17 | 0,0,0,} 18 | 0,0,0, 19 | 0,1,0,bar(); 20 | 0,1,0,baz(); 21 | 0,1,0,foo(); 22 | -------------------------------------------------------------------------------- /t/test02.calls: -------------------------------------------------------------------------------- 1 | main::bar 2 2 | main::bar;main::CORE:print 2 3 | main::foo 1 4 | main::foo;main::CORE:print 1 5 | main::foo;main::bar 1 6 | main::foo;main::bar;main::CORE:print 1 7 | main::baz 1 8 | main::baz;main::CORE:print 1 9 | main::baz;main::bar 3 10 | main::baz;main::bar;main::CORE:print 3 11 | main::baz;main::foo 1 12 | main::baz;main::foo;main::CORE:print 1 13 | main::baz;main::foo;main::bar 1 14 | main::baz;main::foo;main::bar;main::CORE:print 1 15 | -------------------------------------------------------------------------------- /t/test02.p: -------------------------------------------------------------------------------- 1 | sub foo { 2 | print "in sub foo\n"; 3 | bar(); 4 | } 5 | 6 | sub bar { 7 | print "in sub bar\n"; 8 | } 9 | 10 | sub baz { 11 | print "in sub baz\n"; 12 | bar(); 13 | bar(); 14 | bar(); 15 | foo(); 16 | } 17 | 18 | bar(); 19 | bar(); 20 | baz(); 21 | foo(); 22 | -------------------------------------------------------------------------------- /t/test02.pf: -------------------------------------------------------------------------------- 1 | Name, File location, Time, Avg. Time, Own Time, Invocation Count, Level 2 | main::CORE:print, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 10, 0 3 | main::bar, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 7, 0 4 | main::baz, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 1, 0 5 | main::foo, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 2, 0 6 | -------------------------------------------------------------------------------- /t/test02.pf.csv: -------------------------------------------------------------------------------- 1 | Name, File location, Time, Avg. Time, Own Time, Invocation Count, Level 2 | main::bar, /Users/timbo/repos/nytprof/master/t/test02.p, 0.117, 0.000, 0.067, 7, 0 3 | main::CORE:print, /Users/timbo/repos/nytprof/master/t/test02.p, 0.052, 0.000, 0.052, 10, 0 4 | main::baz, /Users/timbo/repos/nytprof/master/t/test02.p, 0.057, 0.000, 0.026, 1, 0 5 | main::foo, /Users/timbo/repos/nytprof/master/t/test02.p, 0.031, 0.000, 0.019, 2, 0 6 | -------------------------------------------------------------------------------- /t/test02.rdt: -------------------------------------------------------------------------------- 1 | attribute application test02.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 4 ] 18 | fid_block_time 1 7 [ 0 7 ] 19 | fid_block_time 1 11 [ 0 5 ] 20 | fid_block_time 1 18 [ 0 1 ] 21 | fid_block_time 1 19 [ 0 1 ] 22 | fid_block_time 1 20 [ 0 1 ] 23 | fid_block_time 1 21 [ 0 1 ] 24 | fid_fileinfo 1 [ test02.p 1 2 0 0 ] 25 | fid_fileinfo 1 sub main::BEGIN 0-0 26 | fid_fileinfo 1 sub main::CORE:print 0-0 27 | fid_fileinfo 1 sub main::RUNTIME 1-1 28 | fid_fileinfo 1 sub main::bar 6-8 29 | fid_fileinfo 1 sub main::baz 10-16 30 | fid_fileinfo 1 sub main::foo 1-4 31 | fid_fileinfo 1 call 2 main::CORE:print [ 2 0 0 0 0 0 0 main::foo ] 32 | fid_fileinfo 1 call 3 main::bar [ 2 0 0 0 0 0 0 main::foo ] 33 | fid_fileinfo 1 call 7 main::CORE:print [ 7 0 0 0 0 0 0 main::bar ] 34 | fid_fileinfo 1 call 11 main::CORE:print [ 1 0 0 0 0 0 0 main::baz ] 35 | fid_fileinfo 1 call 12 main::bar [ 1 0 0 0 0 0 0 main::baz ] 36 | fid_fileinfo 1 call 13 main::bar [ 1 0 0 0 0 0 0 main::baz ] 37 | fid_fileinfo 1 call 14 main::bar [ 1 0 0 0 0 0 0 main::baz ] 38 | fid_fileinfo 1 call 15 main::foo [ 1 0 0 0 0 0 0 main::baz ] 39 | fid_fileinfo 1 call 18 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_fileinfo 1 call 19 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | fid_fileinfo 1 call 20 main::baz [ 1 0 0 0 0 0 0 main::RUNTIME ] 42 | fid_fileinfo 1 call 21 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 43 | fid_line_time 1 2 [ 0 2 ] 44 | fid_line_time 1 3 [ 0 2 ] 45 | fid_line_time 1 7 [ 0 7 ] 46 | fid_line_time 1 11 [ 0 1 ] 47 | fid_line_time 1 12 [ 0 1 ] 48 | fid_line_time 1 13 [ 0 1 ] 49 | fid_line_time 1 14 [ 0 1 ] 50 | fid_line_time 1 15 [ 0 1 ] 51 | fid_line_time 1 18 [ 0 1 ] 52 | fid_line_time 1 19 [ 0 1 ] 53 | fid_line_time 1 20 [ 0 1 ] 54 | fid_line_time 1 21 [ 0 1 ] 55 | fid_sub_time 1 2 [ 0 4 ] 56 | fid_sub_time 1 7 [ 0 7 ] 57 | fid_sub_time 1 11 [ 0 5 ] 58 | fid_sub_time 1 18 [ 0 1 ] 59 | fid_sub_time 1 19 [ 0 1 ] 60 | fid_sub_time 1 20 [ 0 1 ] 61 | fid_sub_time 1 21 [ 0 1 ] 62 | profile_modes fid_block_time block 63 | profile_modes fid_line_time line 64 | profile_modes fid_sub_time sub 65 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 66 | sub_subinfo main::CORE:print [ 1:0-0 calls 10 times 0 0 0 0 ] 67 | sub_subinfo main::CORE:print called_by 1:2 [ 2 0 0 0 0 0 0 main::foo ] 68 | sub_subinfo main::CORE:print called_by 1:7 [ 7 0 0 0 0 0 0 main::bar ] 69 | sub_subinfo main::CORE:print called_by 1:11 [ 1 0 0 0 0 0 0 main::baz ] 70 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 71 | sub_subinfo main::bar [ 1:6-8 calls 7 times 0 0 0 0 ] 72 | sub_subinfo main::bar called_by 1:3 [ 2 0 0 0 0 0 0 main::foo ] 73 | sub_subinfo main::bar called_by 1:12 [ 1 0 0 0 0 0 0 main::baz ] 74 | sub_subinfo main::bar called_by 1:13 [ 1 0 0 0 0 0 0 main::baz ] 75 | sub_subinfo main::bar called_by 1:14 [ 1 0 0 0 0 0 0 main::baz ] 76 | sub_subinfo main::bar called_by 1:18 [ 1 0 0 0 0 0 0 main::RUNTIME ] 77 | sub_subinfo main::bar called_by 1:19 [ 1 0 0 0 0 0 0 main::RUNTIME ] 78 | sub_subinfo main::baz [ 1:10-16 calls 1 times 0 0 0 0 ] 79 | sub_subinfo main::baz called_by 1:20 [ 1 0 0 0 0 0 0 main::RUNTIME ] 80 | sub_subinfo main::foo [ 1:1-4 calls 2 times 0 0 0 0 ] 81 | sub_subinfo main::foo called_by 1:15 [ 1 0 0 0 0 0 0 main::baz ] 82 | sub_subinfo main::foo called_by 1:21 [ 1 0 0 0 0 0 0 main::RUNTIME ] 83 | -------------------------------------------------------------------------------- /t/test02.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test02.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,sub foo { 5 | 0,2,0,print "in sub foo\n"; 6 | 0,2,0,bar(); 7 | 0,0,0,} 8 | 0,0,0, 9 | 0,0,0,sub bar { 10 | 0,7,0,print "in sub bar\n"; 11 | 0,0,0,} 12 | 0,0,0, 13 | 0,0,0,sub baz { 14 | 0,1,0,print "in sub baz\n"; 15 | 0,1,0,bar(); 16 | 0,1,0,bar(); 17 | 0,1,0,bar(); 18 | 0,1,0,foo(); 19 | 0,0,0,} 20 | 0,0,0, 21 | 0,1,0,bar(); 22 | 0,1,0,bar(); 23 | 0,1,0,baz(); 24 | 0,1,0,foo(); 25 | -------------------------------------------------------------------------------- /t/test03.calls: -------------------------------------------------------------------------------- 1 | main::bar 1 2 | main::bar;main::CORE:print 1 3 | main::baz 1 4 | main::baz;main::CORE:print 1 5 | main::baz;main::bar 1 6 | main::baz;main::bar;main::CORE:print 1 7 | main::baz;main::foo 1 8 | main::baz;main::foo;main::CORE:print 1 9 | -------------------------------------------------------------------------------- /t/test03.p: -------------------------------------------------------------------------------- 1 | sub foo { 2 | print "in sub foo\n"; 3 | exit(0); 4 | bar(); 5 | } 6 | 7 | sub bar { 8 | print "in sub bar\n"; 9 | } 10 | 11 | sub baz { 12 | print "in sub baz\n"; 13 | bar(); 14 | foo(); 15 | } 16 | 17 | bar(); 18 | baz(); 19 | foo(); 20 | -------------------------------------------------------------------------------- /t/test03.rdt: -------------------------------------------------------------------------------- 1 | attribute application test03.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 2 ] 18 | fid_block_time 1 8 [ 0 2 ] 19 | fid_block_time 1 12 [ 0 3 ] 20 | fid_block_time 1 17 [ 0 1 ] 21 | fid_block_time 1 18 [ 0 1 ] 22 | fid_fileinfo 1 [ test03.p 1 2 0 0 ] 23 | fid_fileinfo 1 sub main::BEGIN 0-0 24 | fid_fileinfo 1 sub main::CORE:print 0-0 25 | fid_fileinfo 1 sub main::RUNTIME 1-1 26 | fid_fileinfo 1 sub main::bar 7-9 27 | fid_fileinfo 1 sub main::baz 11-15 28 | fid_fileinfo 1 sub main::foo 1-5 29 | fid_fileinfo 1 call 2 main::CORE:print [ 1 0 0 0 0 0 0 main::foo ] 30 | fid_fileinfo 1 call 8 main::CORE:print [ 2 0 0 0 0 0 0 main::bar ] 31 | fid_fileinfo 1 call 12 main::CORE:print [ 1 0 0 0 0 0 0 main::baz ] 32 | fid_fileinfo 1 call 13 main::bar [ 1 0 0 0 0 0 0 main::baz ] 33 | fid_fileinfo 1 call 14 main::foo [ 1 0 0 0 0 0 0 main::baz ] 34 | fid_fileinfo 1 call 17 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 35 | fid_fileinfo 1 call 18 main::baz [ 1 0 0 0 0 0 0 main::RUNTIME ] 36 | fid_line_time 1 2 [ 0 1 ] 37 | fid_line_time 1 3 [ 0 1 ] 38 | fid_line_time 1 8 [ 0 2 ] 39 | fid_line_time 1 12 [ 0 1 ] 40 | fid_line_time 1 13 [ 0 1 ] 41 | fid_line_time 1 14 [ 0 1 ] 42 | fid_line_time 1 17 [ 0 1 ] 43 | fid_line_time 1 18 [ 0 1 ] 44 | fid_sub_time 1 2 [ 0 2 ] 45 | fid_sub_time 1 8 [ 0 2 ] 46 | fid_sub_time 1 12 [ 0 3 ] 47 | fid_sub_time 1 17 [ 0 1 ] 48 | fid_sub_time 1 18 [ 0 1 ] 49 | profile_modes fid_block_time block 50 | profile_modes fid_line_time line 51 | profile_modes fid_sub_time sub 52 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 53 | sub_subinfo main::CORE:print [ 1:0-0 calls 4 times 0 0 0 0 ] 54 | sub_subinfo main::CORE:print called_by 1:2 [ 1 0 0 0 0 0 0 main::foo ] 55 | sub_subinfo main::CORE:print called_by 1:8 [ 2 0 0 0 0 0 0 main::bar ] 56 | sub_subinfo main::CORE:print called_by 1:12 [ 1 0 0 0 0 0 0 main::baz ] 57 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 58 | sub_subinfo main::bar [ 1:7-9 calls 2 times 0 0 0 0 ] 59 | sub_subinfo main::bar called_by 1:13 [ 1 0 0 0 0 0 0 main::baz ] 60 | sub_subinfo main::bar called_by 1:17 [ 1 0 0 0 0 0 0 main::RUNTIME ] 61 | sub_subinfo main::baz [ 1:11-15 calls 1 times 0 0 0 0 ] 62 | sub_subinfo main::baz called_by 1:18 [ 1 0 0 0 0 0 0 main::RUNTIME ] 63 | sub_subinfo main::foo [ 1:1-5 calls 1 times 0 0 0 0 ] 64 | sub_subinfo main::foo called_by 1:14 [ 1 0 0 0 0 0 0 main::baz ] 65 | -------------------------------------------------------------------------------- /t/test03.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test03.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,sub foo { 5 | 0,1,0,print "in sub foo\n"; 6 | 0,1,0,exit(0); 7 | 0,0,0,bar(); 8 | 0,0,0,} 9 | 0,0,0, 10 | 0,0,0,sub bar { 11 | 0,2,0,print "in sub bar\n"; 12 | 0,0,0,} 13 | 0,0,0, 14 | 0,0,0,sub baz { 15 | 0,1,0,print "in sub baz\n"; 16 | 0,1,0,bar(); 17 | 0,1,0,foo(); 18 | 0,0,0,} 19 | 0,0,0, 20 | 0,1,0,bar(); 21 | 0,1,0,baz(); 22 | 0,0,0,foo(); 23 | -------------------------------------------------------------------------------- /t/test05.calls: -------------------------------------------------------------------------------- 1 | main::foo1 1 2 | main::foo1;main::CORE:print 1 3 | main::foo1;main::bar 1 4 | main::foo1;main::bar;main::CORE:print 1 5 | main::foo1;main::bar;main::yeppers 1 6 | main::foo1;main::bar;main::yeppers;main::CORE:print 1 7 | main::foo2 1 8 | main::foo2;main::CORE:print 1 9 | main::foo2;main::bar 1 10 | main::foo2;main::bar;main::CORE:print 1 11 | main::foo2;main::bar;main::yeppers 1 12 | main::foo2;main::bar;main::yeppers;main::CORE:print 1 13 | -------------------------------------------------------------------------------- /t/test05.p: -------------------------------------------------------------------------------- 1 | # Test that fastprof doesn't break 2 | # &bar; used as &bar(@_); 3 | 4 | sub foo1 { 5 | print "in foo1(@_)\n"; 6 | bar(@_); 7 | } 8 | sub foo2 { 9 | print "in foo2(@_)\n"; 10 | &bar; 11 | } 12 | sub bar { 13 | print "in bar(@_)\n"; 14 | if( @_ > 0 ){ 15 | &yeppers; 16 | } 17 | } 18 | sub yeppers { 19 | print "rest easy\n"; 20 | } 21 | 22 | &foo1( A ); 23 | &foo2( B ); 24 | -------------------------------------------------------------------------------- /t/test05.rdt: -------------------------------------------------------------------------------- 1 | attribute application test05.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 5 [ 0 2 ] 18 | fid_block_time 1 9 [ 0 2 ] 19 | fid_block_time 1 13 [ 0 4 ] 20 | fid_block_time 1 19 [ 0 2 ] 21 | fid_block_time 1 22 [ 0 1 ] 22 | fid_block_time 1 23 [ 0 1 ] 23 | fid_fileinfo 1 [ test05.p 1 2 0 0 ] 24 | fid_fileinfo 1 sub main::BEGIN 0-0 25 | fid_fileinfo 1 sub main::CORE:print 0-0 26 | fid_fileinfo 1 sub main::RUNTIME 1-1 27 | fid_fileinfo 1 sub main::bar 12-17 28 | fid_fileinfo 1 sub main::foo1 4-7 29 | fid_fileinfo 1 sub main::foo2 8-11 30 | fid_fileinfo 1 sub main::yeppers 18-20 31 | fid_fileinfo 1 call 5 main::CORE:print [ 1 0 0 0 0 0 0 main::foo1 ] 32 | fid_fileinfo 1 call 6 main::bar [ 1 0 0 0 0 0 0 main::foo1 ] 33 | fid_fileinfo 1 call 9 main::CORE:print [ 1 0 0 0 0 0 0 main::foo2 ] 34 | fid_fileinfo 1 call 10 main::bar [ 1 0 0 0 0 0 0 main::foo2 ] 35 | fid_fileinfo 1 call 13 main::CORE:print [ 2 0 0 0 0 0 0 main::bar ] 36 | fid_fileinfo 1 call 14 main::yeppers [ 2 0 0 0 0 0 0 main::bar ] 37 | fid_fileinfo 1 call 19 main::CORE:print [ 2 0 0 0 0 0 0 main::yeppers ] 38 | fid_fileinfo 1 call 22 main::foo1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 39 | fid_fileinfo 1 call 23 main::foo2 [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_line_time 1 5 [ 0 1 ] 41 | fid_line_time 1 6 [ 0 1 ] 42 | fid_line_time 1 9 [ 0 1 ] 43 | fid_line_time 1 10 [ 0 1 ] 44 | fid_line_time 1 13 [ 0 2 ] 45 | fid_line_time 1 14 [ 0 2 ] 46 | fid_line_time 1 19 [ 0 2 ] 47 | fid_line_time 1 22 [ 0 1 ] 48 | fid_line_time 1 23 [ 0 1 ] 49 | fid_sub_time 1 5 [ 0 2 ] 50 | fid_sub_time 1 9 [ 0 2 ] 51 | fid_sub_time 1 13 [ 0 4 ] 52 | fid_sub_time 1 19 [ 0 2 ] 53 | fid_sub_time 1 22 [ 0 1 ] 54 | fid_sub_time 1 23 [ 0 1 ] 55 | profile_modes fid_block_time block 56 | profile_modes fid_line_time line 57 | profile_modes fid_sub_time sub 58 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 59 | sub_subinfo main::CORE:print [ 1:0-0 calls 6 times 0 0 0 0 ] 60 | sub_subinfo main::CORE:print called_by 1:5 [ 1 0 0 0 0 0 0 main::foo1 ] 61 | sub_subinfo main::CORE:print called_by 1:9 [ 1 0 0 0 0 0 0 main::foo2 ] 62 | sub_subinfo main::CORE:print called_by 1:13 [ 2 0 0 0 0 0 0 main::bar ] 63 | sub_subinfo main::CORE:print called_by 1:19 [ 2 0 0 0 0 0 0 main::yeppers ] 64 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 65 | sub_subinfo main::bar [ 1:12-17 calls 2 times 0 0 0 0 ] 66 | sub_subinfo main::bar called_by 1:6 [ 1 0 0 0 0 0 0 main::foo1 ] 67 | sub_subinfo main::bar called_by 1:10 [ 1 0 0 0 0 0 0 main::foo2 ] 68 | sub_subinfo main::foo1 [ 1:4-7 calls 1 times 0 0 0 0 ] 69 | sub_subinfo main::foo1 called_by 1:22 [ 1 0 0 0 0 0 0 main::RUNTIME ] 70 | sub_subinfo main::foo2 [ 1:8-11 calls 1 times 0 0 0 0 ] 71 | sub_subinfo main::foo2 called_by 1:23 [ 1 0 0 0 0 0 0 main::RUNTIME ] 72 | sub_subinfo main::yeppers [ 1:18-20 calls 2 times 0 0 0 0 ] 73 | sub_subinfo main::yeppers called_by 1:14 [ 2 0 0 0 0 0 0 main::bar ] 74 | -------------------------------------------------------------------------------- /t/test05.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test05.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# Test that fastprof doesn't break 5 | 0,0,0,# &bar; used as &bar(@_); 6 | 0,0,0, 7 | 0,0,0,sub foo1 { 8 | 0,1,0,print "in foo1(@_)\n"; 9 | 0,1,0,bar(@_); 10 | 0,0,0,} 11 | 0,0,0,sub foo2 { 12 | 0,1,0,print "in foo2(@_)\n"; 13 | 0,1,0,&bar; 14 | 0,0,0,} 15 | 0,0,0,sub bar { 16 | 0,2,0,print "in bar(@_)\n"; 17 | 0,2,0,if( @_ > 0 ){ 18 | 0,0,0,&yeppers; 19 | 0,0,0,} 20 | 0,0,0,} 21 | 0,0,0,sub yeppers { 22 | 0,2,0,print "rest easy\n"; 23 | 0,0,0,} 24 | 0,0,0, 25 | 0,1,0,&foo1( A ); 26 | 0,1,0,&foo2( B ); 27 | -------------------------------------------------------------------------------- /t/test06.calls: -------------------------------------------------------------------------------- 1 | main::foo 1 2 | main::foo;main::CORE:print 1 3 | main::foo;main::noop 110 4 | main::bar 1 5 | main::bar;main::CORE:print 1 6 | main::bar;main::noop 100 7 | main::baz 1 8 | main::baz;main::CORE:print 1 9 | main::baz;main::noop 200 10 | -------------------------------------------------------------------------------- /t/test06.p: -------------------------------------------------------------------------------- 1 | # tests loops. noop is a hack for perl>5.6 where 2 | # the closing "}" of a loop counts as being executed if loop is empty. 3 | 4 | my $_z; 5 | sub noop { 6 | $_z++; 7 | } 8 | 9 | sub foo { 10 | print "in sub foo\n"; 11 | foreach (1 .. 10) { 12 | noop(); 13 | foreach (1 .. 10) { 14 | noop(); 15 | } 16 | } 17 | } 18 | 19 | sub bar { 20 | print "in sub bar\n"; 21 | my ($x, $y); 22 | while (10 > $x++) { 23 | $y = 0; 24 | while (10 > $y++) { 25 | noop(); 26 | } 27 | } 28 | } 29 | 30 | sub baz { 31 | print "in sub baz\n"; 32 | my ($x, $y) = (1); 33 | do { 34 | $y = 1; 35 | do { 36 | noop(); 37 | noop(); 38 | } while(10 > $y++); 39 | } while(10 > $x++); 40 | } 41 | 42 | foo(); 43 | bar(); 44 | baz(); 45 | -------------------------------------------------------------------------------- /t/test06.rdt: -------------------------------------------------------------------------------- 1 | attribute application test06.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 4 [ 0 1 ] 18 | fid_block_time 1 6 [ 0 410 ] 19 | fid_block_time 1 10 [ 0 2 ] 20 | fid_block_time 1 12 [ 0 20 ] 21 | fid_block_time 1 14 [ 0 100 ] 22 | fid_block_time 1 20 [ 0 3 ] 23 | fid_block_time 1 23 [ 0 20 ] 24 | fid_block_time 1 25 [ 0 100 ] 25 | fid_block_time 1 31 [ 0 3 ] 26 | fid_block_time 1 33 [ 0 20 ] 27 | fid_block_time 1 35 [ 0 200 ] 28 | fid_block_time 1 42 [ 0 1 ] 29 | fid_block_time 1 43 [ 0 1 ] 30 | fid_block_time 1 44 [ 0 1 ] 31 | fid_fileinfo 1 [ test06.p 1 2 0 0 ] 32 | fid_fileinfo 1 sub main::BEGIN 0-0 33 | fid_fileinfo 1 sub main::CORE:print 0-0 34 | fid_fileinfo 1 sub main::RUNTIME 1-1 35 | fid_fileinfo 1 sub main::bar 19-28 36 | fid_fileinfo 1 sub main::baz 30-40 37 | fid_fileinfo 1 sub main::foo 9-17 38 | fid_fileinfo 1 sub main::noop 5-7 39 | fid_fileinfo 1 call 10 main::CORE:print [ 1 0 0 0 0 0 0 main::foo ] 40 | fid_fileinfo 1 call 12 main::noop [ 10 0 0 0 0 0 0 main::foo ] 41 | fid_fileinfo 1 call 14 main::noop [ 100 0 0 0 0 0 0 main::foo ] 42 | fid_fileinfo 1 call 20 main::CORE:print [ 1 0 0 0 0 0 0 main::bar ] 43 | fid_fileinfo 1 call 25 main::noop [ 100 0 0 0 0 0 0 main::bar ] 44 | fid_fileinfo 1 call 31 main::CORE:print [ 1 0 0 0 0 0 0 main::baz ] 45 | fid_fileinfo 1 call 36 main::noop [ 100 0 0 0 0 0 0 main::baz ] 46 | fid_fileinfo 1 call 37 main::noop [ 100 0 0 0 0 0 0 main::baz ] 47 | fid_fileinfo 1 call 42 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 48 | fid_fileinfo 1 call 43 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 49 | fid_fileinfo 1 call 44 main::baz [ 1 0 0 0 0 0 0 main::RUNTIME ] 50 | fid_line_time 1 4 [ 0 1 ] 51 | fid_line_time 1 6 [ 0 410 ] 52 | fid_line_time 1 10 [ 0 1 ] 53 | fid_line_time 1 11 [ 0 1 ] 54 | fid_line_time 1 12 [ 0 10 ] 55 | fid_line_time 1 13 [ 0 10 ] 56 | fid_line_time 1 14 [ 0 100 ] 57 | fid_line_time 1 20 [ 0 1 ] 58 | fid_line_time 1 21 [ 0 1 ] 59 | fid_line_time 1 22 [ 0 1 ] 60 | fid_line_time 1 23 [ 0 10 ] 61 | fid_line_time 1 24 [ 0 10 ] 62 | fid_line_time 1 25 [ 0 100 ] 63 | fid_line_time 1 31 [ 0 1 ] 64 | fid_line_time 1 32 [ 0 1 ] 65 | fid_line_time 1 33 [ 0 1 ] 66 | fid_line_time 1 34 [ 0 10 ] 67 | fid_line_time 1 35 [ 0 10 ] 68 | fid_line_time 1 36 [ 0 100 ] 69 | fid_line_time 1 37 [ 0 100 ] 70 | fid_line_time 1 42 [ 0 1 ] 71 | fid_line_time 1 43 [ 0 1 ] 72 | fid_line_time 1 44 [ 0 1 ] 73 | fid_sub_time 1 4 [ 0 1 ] 74 | fid_sub_time 1 6 [ 0 410 ] 75 | fid_sub_time 1 10 [ 0 122 ] 76 | fid_sub_time 1 20 [ 0 123 ] 77 | fid_sub_time 1 31 [ 0 223 ] 78 | fid_sub_time 1 42 [ 0 1 ] 79 | fid_sub_time 1 43 [ 0 1 ] 80 | fid_sub_time 1 44 [ 0 1 ] 81 | profile_modes fid_block_time block 82 | profile_modes fid_line_time line 83 | profile_modes fid_sub_time sub 84 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 85 | sub_subinfo main::CORE:print [ 1:0-0 calls 3 times 0 0 0 0 ] 86 | sub_subinfo main::CORE:print called_by 1:10 [ 1 0 0 0 0 0 0 main::foo ] 87 | sub_subinfo main::CORE:print called_by 1:20 [ 1 0 0 0 0 0 0 main::bar ] 88 | sub_subinfo main::CORE:print called_by 1:31 [ 1 0 0 0 0 0 0 main::baz ] 89 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 90 | sub_subinfo main::bar [ 1:19-28 calls 1 times 0 0 0 0 ] 91 | sub_subinfo main::bar called_by 1:43 [ 1 0 0 0 0 0 0 main::RUNTIME ] 92 | sub_subinfo main::baz [ 1:30-40 calls 1 times 0 0 0 0 ] 93 | sub_subinfo main::baz called_by 1:44 [ 1 0 0 0 0 0 0 main::RUNTIME ] 94 | sub_subinfo main::foo [ 1:9-17 calls 1 times 0 0 0 0 ] 95 | sub_subinfo main::foo called_by 1:42 [ 1 0 0 0 0 0 0 main::RUNTIME ] 96 | sub_subinfo main::noop [ 1:5-7 calls 410 times 0 0 0 0 ] 97 | sub_subinfo main::noop called_by 1:12 [ 10 0 0 0 0 0 0 main::foo ] 98 | sub_subinfo main::noop called_by 1:14 [ 100 0 0 0 0 0 0 main::foo ] 99 | sub_subinfo main::noop called_by 1:25 [ 100 0 0 0 0 0 0 main::bar ] 100 | sub_subinfo main::noop called_by 1:36 [ 100 0 0 0 0 0 0 main::baz ] 101 | sub_subinfo main::noop called_by 1:37 [ 100 0 0 0 0 0 0 main::baz ] 102 | -------------------------------------------------------------------------------- /t/test06.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test06.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# tests loops. noop is a hack for perl>5.6 where 5 | 0,0,0,# the closing "}" of a loop counts as being executed if loop is empty. 6 | 0,0,0, 7 | 0,1,0,my $_z; 8 | 0,0,0,sub noop { 9 | 0,410,0,$_z++; 10 | 0,0,0,} 11 | 0,0,0, 12 | 0,0,0,sub foo { 13 | 0,1,0,print "in sub foo\n"; 14 | 0,1,0,foreach (1 .. 10) { 15 | 0,10,0,noop(); 16 | 0,10,0,foreach (1 .. 10) { 17 | 0,100,0,noop(); 18 | 0,0,0,} 19 | 0,0,0,} 20 | 0,0,0,} 21 | 0,0,0, 22 | 0,0,0,sub bar { 23 | 0,1,0,print "in sub bar\n"; 24 | 0,1,0,my ($x, $y); 25 | 0,1,0,while (10 > $x++) { 26 | 0,10,0,$y = 0; 27 | 0,10,0,while (10 > $y++) { 28 | 0,100,0,noop(); 29 | 0,0,0,} 30 | 0,0,0,} 31 | 0,0,0,} 32 | 0,0,0, 33 | 0,0,0,sub baz { 34 | 0,1,0,print "in sub baz\n"; 35 | 0,1,0,my ($x, $y) = (1); 36 | 0,1,0,do { 37 | 0,10,0,$y = 1; 38 | 0,10,0,do { 39 | 0,100,0,noop(); 40 | 0,100,0,noop(); 41 | 0,0,0,} while(10 > $y++); 42 | 0,0,0,} while(10 > $x++); 43 | 0,0,0,} 44 | 0,0,0, 45 | 0,1,0,foo(); 46 | 0,1,0,bar(); 47 | 0,1,0,baz(); 48 | -------------------------------------------------------------------------------- /t/test07.calls: -------------------------------------------------------------------------------- 1 | main::CORE:print 1 2 | -------------------------------------------------------------------------------- /t/test07.p: -------------------------------------------------------------------------------- 1 | print "only one line\n"; 2 | -------------------------------------------------------------------------------- /t/test07.rdt: -------------------------------------------------------------------------------- 1 | attribute application test07.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 1 [ 0 1 ] 18 | fid_fileinfo 1 [ test07.p 1 2 0 0 ] 19 | fid_fileinfo 1 sub main::BEGIN 0-0 20 | fid_fileinfo 1 sub main::CORE:print 0-0 21 | fid_fileinfo 1 sub main::RUNTIME 1-1 22 | fid_fileinfo 1 call 1 main::CORE:print [ 1 0 0 0 0 0 0 main::RUNTIME ] 23 | fid_line_time 1 1 [ 0 1 ] 24 | fid_sub_time 1 1 [ 0 1 ] 25 | profile_modes fid_block_time block 26 | profile_modes fid_line_time line 27 | profile_modes fid_sub_time sub 28 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 29 | sub_subinfo main::CORE:print [ 1:0-0 calls 1 times 0 0 0 0 ] 30 | sub_subinfo main::CORE:print called_by 1:1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 31 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 32 | -------------------------------------------------------------------------------- /t/test07.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test07.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,1,0,print "only one line\n"; 5 | -------------------------------------------------------------------------------- /t/test08.calls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/test08.calls -------------------------------------------------------------------------------- /t/test08.p: -------------------------------------------------------------------------------- 1 | eval "shift; 2 | shift;"; 3 | -------------------------------------------------------------------------------- /t/test08.rdt: -------------------------------------------------------------------------------- 1 | attribute application test08.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 1 [ 0 1 ] 18 | fid_block_time 2 1 [ 0 1 ] 19 | fid_block_time 2 2 [ 0 1 ] 20 | fid_fileinfo 1 [ test08.p 1 2 0 0 ] 21 | fid_fileinfo 1 sub main::BEGIN 0-0 22 | fid_fileinfo 1 eval 1 [ count 1 nested 0 merged 0 ] 23 | fid_fileinfo 2 [ (eval 0)[test08.p:1] 1 1 2 2 0 0 ] 24 | fid_line_time 1 1 [ 0 1 ] 25 | fid_line_time 2 1 [ 0 1 ] 26 | fid_line_time 2 2 [ 0 1 ] 27 | fid_sub_time 1 1 [ 0 1 ] 28 | fid_sub_time 2 1 [ 0 1 ] 29 | fid_sub_time 2 2 [ 0 1 ] 30 | profile_modes fid_block_time block 31 | profile_modes fid_line_time line 32 | profile_modes fid_sub_time sub 33 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 34 | -------------------------------------------------------------------------------- /t/test08.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test08.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,1,0,eval "shift; 5 | 0,0,0,shift;"; 6 | -------------------------------------------------------------------------------- /t/test09.calls: -------------------------------------------------------------------------------- 1 | main::bar 1 2 | main::foo 2 3 | main::foo;main::bar 2 4 | -------------------------------------------------------------------------------- /t/test09.p: -------------------------------------------------------------------------------- 1 | sub foo { 2 | eval "shift; 3 | shift; 4 | bar();"; 5 | } 6 | 7 | sub bar { 8 | eval '$a = 10_001; while (--$a) { ++$b }'; 9 | } 10 | 11 | foo(); 12 | foo(); 13 | bar(); 14 | -------------------------------------------------------------------------------- /t/test09.rdt: -------------------------------------------------------------------------------- 1 | attribute application test09.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 2 ] 18 | fid_block_time 1 8 [ 0 3 ] 19 | fid_block_time 1 11 [ 0 1 ] 20 | fid_block_time 1 12 [ 0 1 ] 21 | fid_block_time 1 13 [ 0 1 ] 22 | fid_block_time 2 1 [ 0 1 ] 23 | fid_block_time 2 2 [ 0 1 ] 24 | fid_block_time 2 3 [ 0 1 ] 25 | fid_block_time 3 1 [ 0 10002 ] 26 | fid_fileinfo 1 [ test09.p 1 2 0 0 ] 27 | fid_fileinfo 1 sub main::BEGIN 0-0 28 | fid_fileinfo 1 sub main::RUNTIME 1-1 29 | fid_fileinfo 1 sub main::bar 7-9 30 | fid_fileinfo 1 sub main::foo 1-5 31 | fid_fileinfo 1 call 11 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 32 | fid_fileinfo 1 call 12 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 33 | fid_fileinfo 1 call 13 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 34 | fid_fileinfo 1 eval 2 [ count 1 nested 0 merged 1 ] 35 | fid_fileinfo 1 eval 8 [ count 1 nested 0 merged 2 ] 36 | fid_fileinfo 2 [ (eval 0)[test09.p:2] 1 2 2 2 0 0 ] 37 | fid_fileinfo 2 call 3 main::bar [ 2 0 0 0 0 0 0 main::foo ] 38 | fid_fileinfo 3 [ (eval 0)[test09.p:8] 1 8 3 2 0 0 ] 39 | fid_line_time 1 2 [ 0 2 ] 40 | fid_line_time 1 8 [ 0 3 ] 41 | fid_line_time 1 11 [ 0 1 ] 42 | fid_line_time 1 12 [ 0 1 ] 43 | fid_line_time 1 13 [ 0 1 ] 44 | fid_line_time 2 1 [ 0 2 ] 45 | fid_line_time 2 2 [ 0 2 ] 46 | fid_line_time 2 3 [ 0 2 ] 47 | fid_line_time 3 1 [ 0 30006 ] 48 | fid_sub_time 1 2 [ 0 2 ] 49 | fid_sub_time 1 8 [ 0 3 ] 50 | fid_sub_time 1 11 [ 0 1 ] 51 | fid_sub_time 1 12 [ 0 1 ] 52 | fid_sub_time 1 13 [ 0 1 ] 53 | fid_sub_time 2 1 [ 0 1 ] 54 | fid_sub_time 2 2 [ 0 1 ] 55 | fid_sub_time 2 3 [ 0 1 ] 56 | fid_sub_time 3 1 [ 0 10002 ] 57 | profile_modes fid_block_time block 58 | profile_modes fid_line_time line 59 | profile_modes fid_sub_time sub 60 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 61 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 62 | sub_subinfo main::bar [ 1:7-9 calls 3 times 0 0 0 0 ] 63 | sub_subinfo main::bar called_by 1:13 [ 1 0 0 0 0 0 0 main::RUNTIME ] 64 | sub_subinfo main::bar called_by 2:3 [ 2 0 0 0 0 0 0 main::foo ] 65 | sub_subinfo main::foo [ 1:1-5 calls 2 times 0 0 0 0 ] 66 | sub_subinfo main::foo called_by 1:11 [ 1 0 0 0 0 0 0 main::RUNTIME ] 67 | sub_subinfo main::foo called_by 1:12 [ 1 0 0 0 0 0 0 main::RUNTIME ] 68 | -------------------------------------------------------------------------------- /t/test09.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test09.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,sub foo { 5 | 0,2,0,eval "shift; 6 | 0,0,0,shift; 7 | 0,0,0,bar();"; 8 | 0,0,0,} 9 | 0,0,0, 10 | 0,0,0,sub bar { 11 | 0,3,0,eval '$a = 10_001; while (--$a) { ++$b }'; 12 | 0,0,0,} 13 | 0,0,0, 14 | 0,1,0,foo(); 15 | 0,1,0,foo(); 16 | 0,1,0,bar(); 17 | -------------------------------------------------------------------------------- /t/test10.calls: -------------------------------------------------------------------------------- 1 | main::__ANON__[(eval 0)[test10.p:1]:1] 1 2 | main::__ANON__[(eval 0)[test10.p:1]:1];main::CORE:sleep 1 3 | -------------------------------------------------------------------------------- /t/test10.p: -------------------------------------------------------------------------------- 1 | $code = eval "sub { sleep 1; }$Devel::NYTProf::StrEvalTestPad"; 2 | $code->(); 3 | -------------------------------------------------------------------------------- /t/test10.rdt: -------------------------------------------------------------------------------- 1 | attribute application test10.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 1 [ 0 1 ] 18 | fid_block_time 1 2 [ 0 1 ] 19 | fid_block_time 2 1 [ 0 2 ] 20 | fid_fileinfo 1 [ test10.p 1 2 0 0 ] 21 | fid_fileinfo 1 sub main::BEGIN 0-0 22 | fid_fileinfo 1 sub main::CORE:sleep 0-0 23 | fid_fileinfo 1 sub main::RUNTIME 1-1 24 | fid_fileinfo 1 call 2 main::__ANON__[(eval 0)[test10.p:1]:1] [ 1 0 0 0 0 0 0 main::RUNTIME ] 25 | fid_fileinfo 1 eval 1 [ count 1 nested 0 merged 0 ] 26 | fid_fileinfo 2 [ (eval 0)[test10.p:1] 1 1 2 2 0 0 ] 27 | fid_fileinfo 2 sub main::__ANON__[(eval 0)[test10.p:1]:1] 1-1 28 | fid_fileinfo 2 call 1 main::CORE:sleep [ 1 0 0 0 0 0 0 main::__ANON__[(eval 0)[test10.p:1]:1] ] 29 | fid_line_time 1 1 [ 0 1 ] 30 | fid_line_time 1 2 [ 0 1 ] 31 | fid_line_time 2 1 [ 0 2 ] 32 | fid_sub_time 1 1 [ 0 1 ] 33 | fid_sub_time 1 2 [ 0 1 ] 34 | fid_sub_time 2 1 [ 0 2 ] 35 | profile_modes fid_block_time block 36 | profile_modes fid_line_time line 37 | profile_modes fid_sub_time sub 38 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 39 | sub_subinfo main::CORE:sleep [ 1:0-0 calls 1 times 0 0 0 0 ] 40 | sub_subinfo main::CORE:sleep called_by 2:1 [ 1 0 0 0 0 0 0 main::__ANON__[(eval 0)[test10.p:1]:1] ] 41 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 42 | sub_subinfo main::__ANON__[(eval 0)[test10.p:1]:1] [ 2:1-1 calls 1 times 0 0 0 0 ] 43 | sub_subinfo main::__ANON__[(eval 0)[test10.p:1]:1] called_by 1:2 [ 1 0 0 0 0 0 0 main::RUNTIME ] 44 | -------------------------------------------------------------------------------- /t/test10.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test10.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | ~1,1,0,$code = eval "sub { sleep 1; }$Devel::NYTProf::StrEvalTestPad"; 5 | 0,1,0,$code->(); 6 | -------------------------------------------------------------------------------- /t/test11.calls: -------------------------------------------------------------------------------- 1 | main::__ANON__[(eval 0)[test11.p:3]:1] 2 2 | -------------------------------------------------------------------------------- /t/test11.p: -------------------------------------------------------------------------------- 1 | use vars qw/$b/; 2 | BEGIN { 3 | $b = eval "sub {1}"; 4 | } 5 | &$b; 6 | &$b; 7 | -------------------------------------------------------------------------------- /t/test11.rdt: -------------------------------------------------------------------------------- 1 | attribute application test11.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 5 [ 0 1 ] 18 | fid_block_time 1 6 [ 0 1 ] 19 | fid_block_time 2 1 [ 0 2 ] 20 | fid_fileinfo 1 [ test11.p 1 2 0 0 ] 21 | fid_fileinfo 1 sub main::BEGIN 2-4 22 | fid_fileinfo 1 sub main::RUNTIME 1-1 23 | fid_fileinfo 1 call 5 main::__ANON__[(eval 0)[test11.p:3]:1] [ 1 0 0 0 0 0 0 main::RUNTIME ] 24 | fid_fileinfo 1 call 6 main::__ANON__[(eval 0)[test11.p:3]:1] [ 1 0 0 0 0 0 0 main::RUNTIME ] 25 | fid_fileinfo 1 eval 3 [ count 1 nested 0 merged 0 ] 26 | fid_fileinfo 2 [ (eval 0)[test11.p:3] 1 3 2 2 0 0 ] 27 | fid_fileinfo 2 sub main::__ANON__[(eval 0)[test11.p:3]:1] 1-1 28 | fid_line_time 1 5 [ 0 1 ] 29 | fid_line_time 1 6 [ 0 1 ] 30 | fid_line_time 2 1 [ 0 2 ] 31 | fid_sub_time 1 5 [ 0 1 ] 32 | fid_sub_time 1 6 [ 0 1 ] 33 | fid_sub_time 2 1 [ 0 2 ] 34 | profile_modes fid_block_time block 35 | profile_modes fid_line_time line 36 | profile_modes fid_sub_time sub 37 | sub_subinfo main::BEGIN [ 1:2-4 calls 0 times 0 0 0 0 ] 38 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 39 | sub_subinfo main::__ANON__[(eval 0)[test11.p:3]:1] [ 2:1-1 calls 2 times 0 0 0 0 ] 40 | sub_subinfo main::__ANON__[(eval 0)[test11.p:3]:1] called_by 1:5 [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | sub_subinfo main::__ANON__[(eval 0)[test11.p:3]:1] called_by 1:6 [ 1 0 0 0 0 0 0 main::RUNTIME ] 42 | -------------------------------------------------------------------------------- /t/test11.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test11.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,use vars qw/$b/; 5 | 0,0,0,BEGIN { 6 | 0,0,0,$b = eval "sub {1}"; 7 | 0,0,0,} 8 | 0,1,0,&$b; 9 | 0,1,0,&$b; 10 | -------------------------------------------------------------------------------- /t/test12.calls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/test12.calls -------------------------------------------------------------------------------- /t/test12.p: -------------------------------------------------------------------------------- 1 | do 'test12.pl'; 2 | -------------------------------------------------------------------------------- /t/test12.pl: -------------------------------------------------------------------------------- 1 | 1; 2 | -------------------------------------------------------------------------------- /t/test12.rdt: -------------------------------------------------------------------------------- 1 | attribute application test12.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 1 [ 0 1 ] 18 | fid_block_time 2 1 [ 0 1 ] 19 | fid_fileinfo 1 [ test12.p 1 2 0 0 ] 20 | fid_fileinfo 1 sub main::BEGIN 0-0 21 | fid_fileinfo 2 [ test12.pl 2 2 0 0 ] 22 | fid_line_time 1 1 [ 0 1 ] 23 | fid_line_time 2 1 [ 0 1 ] 24 | fid_sub_time 1 1 [ 0 1 ] 25 | fid_sub_time 2 1 [ 0 1 ] 26 | profile_modes fid_block_time block 27 | profile_modes fid_line_time line 28 | profile_modes fid_sub_time sub 29 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 30 | -------------------------------------------------------------------------------- /t/test12.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test12.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,1,0,do 'test12.pl'; 5 | -------------------------------------------------------------------------------- /t/test13.calls: -------------------------------------------------------------------------------- 1 | main::foo 1 2 | main::foo;main::CORE:print 1 3 | main::bar 1 4 | main::bar;main::CORE:print 1 5 | main::baz 1 6 | main::baz;main::CORE:print 1 7 | main::baz;main::foo 2 8 | main::baz;main::foo;main::CORE:print 2 9 | main::baz;main::x 1 10 | -------------------------------------------------------------------------------- /t/test13.p: -------------------------------------------------------------------------------- 1 | # Testing various types of eval calls. Some are processed differently internally 2 | 3 | sub foo { 4 | print "in sub foo\n"; 5 | } 6 | 7 | sub bar { 8 | print "in sub bar\n"; 9 | } 10 | 11 | sub baz { 12 | print "in sub baz\n"; 13 | eval { foo(); # two stmts executed on this line (eval + foo() call) 14 | foo(); }; # one stmt executed on this line 15 | eval { x(); # two stmts executed on this line (eval + x() call), fails out of eval 16 | x(); }; # zero stmts because previous statement threw an exception 17 | } 18 | 19 | eval "foo();"; # one stmt in this fid, one statement in eval fid 20 | eval { bar(); }; # two stmts 21 | baz(); 22 | -------------------------------------------------------------------------------- /t/test13.rdt: -------------------------------------------------------------------------------- 1 | attribute application test13.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 4 [ 0 3 ] 18 | fid_block_time 1 8 [ 0 1 ] 19 | fid_block_time 1 12 [ 0 3 ] 20 | fid_block_time 1 13 [ 0 2 ] 21 | fid_block_time 1 15 [ 0 1 ] 22 | fid_block_time 1 19 [ 0 1 ] 23 | fid_block_time 1 20 [ 0 2 ] 24 | fid_block_time 1 21 [ 0 1 ] 25 | fid_block_time 2 1 [ 0 1 ] 26 | fid_fileinfo 1 [ test13.p 1 2 0 0 ] 27 | fid_fileinfo 1 sub main::BEGIN 0-0 28 | fid_fileinfo 1 sub main::CORE:print 0-0 29 | fid_fileinfo 1 sub main::RUNTIME 1-1 30 | fid_fileinfo 1 sub main::bar 7-9 31 | fid_fileinfo 1 sub main::baz 11-17 32 | fid_fileinfo 1 sub main::foo 3-5 33 | fid_fileinfo 1 sub main::x undef-undef 34 | fid_fileinfo 1 call 4 main::CORE:print [ 3 0 0 0 0 0 0 main::foo ] 35 | fid_fileinfo 1 call 8 main::CORE:print [ 1 0 0 0 0 0 0 main::bar ] 36 | fid_fileinfo 1 call 12 main::CORE:print [ 1 0 0 0 0 0 0 main::baz ] 37 | fid_fileinfo 1 call 13 main::foo [ 1 0 0 0 0 0 0 main::baz ] 38 | fid_fileinfo 1 call 14 main::foo [ 1 0 0 0 0 0 0 main::baz ] 39 | fid_fileinfo 1 call 15 main::x [ 1 0 0 0 0 0 0 main::baz ] 40 | fid_fileinfo 1 call 20 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | fid_fileinfo 1 call 21 main::baz [ 1 0 0 0 0 0 0 main::RUNTIME ] 42 | fid_fileinfo 1 eval 19 [ count 1 nested 0 merged 0 ] 43 | fid_fileinfo 2 [ (eval 0)[test13.p:19] 1 19 2 2 0 0 ] 44 | fid_fileinfo 2 call 1 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 45 | fid_line_time 1 4 [ 0 3 ] 46 | fid_line_time 1 8 [ 0 1 ] 47 | fid_line_time 1 12 [ 0 1 ] 48 | fid_line_time 1 13 [ 0 2 ] 49 | fid_line_time 1 14 [ 0 1 ] 50 | fid_line_time 1 15 [ 0 2 ] 51 | fid_line_time 1 19 [ 0 1 ] 52 | fid_line_time 1 20 [ 0 2 ] 53 | fid_line_time 1 21 [ 0 1 ] 54 | fid_line_time 2 1 [ 0 1 ] 55 | fid_sub_time 1 4 [ 0 3 ] 56 | fid_sub_time 1 8 [ 0 1 ] 57 | fid_sub_time 1 12 [ 0 6 ] 58 | fid_sub_time 1 19 [ 0 1 ] 59 | fid_sub_time 1 20 [ 0 2 ] 60 | fid_sub_time 1 21 [ 0 1 ] 61 | fid_sub_time 2 1 [ 0 1 ] 62 | profile_modes fid_block_time block 63 | profile_modes fid_line_time line 64 | profile_modes fid_sub_time sub 65 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 66 | sub_subinfo main::CORE:print [ 1:0-0 calls 5 times 0 0 0 0 ] 67 | sub_subinfo main::CORE:print called_by 1:4 [ 3 0 0 0 0 0 0 main::foo ] 68 | sub_subinfo main::CORE:print called_by 1:8 [ 1 0 0 0 0 0 0 main::bar ] 69 | sub_subinfo main::CORE:print called_by 1:12 [ 1 0 0 0 0 0 0 main::baz ] 70 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 71 | sub_subinfo main::bar [ 1:7-9 calls 1 times 0 0 0 0 ] 72 | sub_subinfo main::bar called_by 1:20 [ 1 0 0 0 0 0 0 main::RUNTIME ] 73 | sub_subinfo main::baz [ 1:11-17 calls 1 times 0 0 0 0 ] 74 | sub_subinfo main::baz called_by 1:21 [ 1 0 0 0 0 0 0 main::RUNTIME ] 75 | sub_subinfo main::foo [ 1:3-5 calls 3 times 0 0 0 0 ] 76 | sub_subinfo main::foo called_by 1:13 [ 1 0 0 0 0 0 0 main::baz ] 77 | sub_subinfo main::foo called_by 1:14 [ 1 0 0 0 0 0 0 main::baz ] 78 | sub_subinfo main::foo called_by 2:1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 79 | sub_subinfo main::x [ 1:undef-undef calls 1 times 0 0 0 0 ] 80 | sub_subinfo main::x called_by 1:15 [ 1 0 0 0 0 0 0 main::baz ] 81 | -------------------------------------------------------------------------------- /t/test13.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test13.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# Testing various types of eval calls. Some are processed differently internally 5 | 0,0,0, 6 | 0,0,0,sub foo { 7 | 0,3,0,print "in sub foo\n"; 8 | 0,0,0,} 9 | 0,0,0, 10 | 0,0,0,sub bar { 11 | 0,1,0,print "in sub bar\n"; 12 | 0,0,0,} 13 | 0,0,0, 14 | 0,0,0,sub baz { 15 | 0,1,0,print "in sub baz\n"; 16 | 0,2,0,eval { foo(); # two stmts executed on this line (eval + foo() call) 17 | 0,1,0,foo(); }; # one stmt executed on this line 18 | 0,2,0,eval { x(); # two stmts executed on this line (eval + x() call), fails out of eval 19 | 0,0,0,x(); }; # zero stmts because previous statement threw an exception 20 | 0,0,0,} 21 | 0,0,0, 22 | 0,1,0,eval "foo();"; # one stmt in this fid, one statement in eval fid 23 | 0,2,0,eval { bar(); }; # two stmts 24 | 0,1,0,baz(); 25 | -------------------------------------------------------------------------------- /t/test14.p: -------------------------------------------------------------------------------- 1 | # If the AutoSplit module has been loaded before we got initialized 2 | # (specifically before we redirected the opcodes used when compiling) 3 | # then the profiler won't profile AutoSplit code so the test will fail 4 | # because the results won't match. 5 | # The tricky part is that we need to take care to avoid being tripped up 6 | # by the fact that XSLoader will fallback to using DynaLoader in some cases 7 | # and DynaLoader uses AutoSplit. 8 | # See Makefile.PL for how we avoid XSLoader fallback to using DynaLoader. 9 | 10 | BEGIN { 11 | use AutoSplit; 12 | mkdir('./auto'); 13 | autosplit('test14', './auto', 1, 0, 0); 14 | } 15 | 16 | use test14; 17 | test14::pre(); 18 | test14::foo(); 19 | test14::bar(); 20 | -------------------------------------------------------------------------------- /t/test14.pm: -------------------------------------------------------------------------------- 1 | package test14; 2 | use AutoLoader 'AUTOLOAD'; 3 | 4 | # The tests run with start=init so we need to arrange to execute some 5 | # profiled code before the first autosplit sub gets loaded in order to 6 | # test the handling of autosplit subs. We could use an INIT block for 7 | # that but calling a sub suits the tests better for obscure reasons. 8 | sub pre { 1 } 9 | 10 | 1; 11 | __END__ 12 | sub foo { 13 | $&; 14 | } 15 | 16 | sub bar { 17 | eval 2; 18 | } 19 | -------------------------------------------------------------------------------- /t/test14.pm_x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,package test14; 5 | 0,0,0,use AutoLoader 'AUTOLOAD'; 6 | 0,0,0, 7 | 0,0,0,1; 8 | 0,0,0,__END__ 9 | 0,0,0,sub foo { 10 | 0,1,0,1; 11 | 0,0,0,} 12 | 0,0,0, 13 | 0,0,0,sub bar { 14 | 0,2,0,eval 2; 15 | 0,0,0,} 16 | -------------------------------------------------------------------------------- /t/test14.rdt: -------------------------------------------------------------------------------- 1 | attribute application test14.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 17 [ 0 1 ] 18 | fid_block_time 1 18 [ 0 1 ] 19 | fid_block_time 1 19 [ 0 1 ] 20 | fid_block_time 2 8 [ 0 1 ] 21 | fid_block_time 2 13 [ 0 1 ] 22 | fid_block_time 2 17 [ 0 2 ] 23 | fid_block_time 2 20 [ 0 1 ] 24 | fid_block_time 4 1 [ 0 1 ] 25 | fid_fileinfo 1 [ test14.p 1 2 0 0 ] 26 | fid_fileinfo 1 sub main::BEGIN 16-16 27 | fid_fileinfo 1 sub main::RUNTIME 1-1 28 | fid_fileinfo 1 call 17 test14::pre [ 1 0 0 0 0 0 0 main::RUNTIME ] 29 | fid_fileinfo 1 call 18 AutoLoader::AUTOLOAD [ 1 0 0 0 0 0 0 main::RUNTIME ] 30 | fid_fileinfo 1 call 19 AutoLoader::AUTOLOAD [ 1 0 0 0 0 0 0 main::RUNTIME ] 31 | fid_fileinfo 2 [ test14.pm 2 2 0 0 ] 32 | fid_fileinfo 2 sub test14::BEGIN 2-2 33 | fid_fileinfo 2 sub test14::bar 16-18 34 | fid_fileinfo 2 sub test14::foo 12-14 35 | fid_fileinfo 2 sub test14::pre 8-8 36 | fid_fileinfo 2 eval 17 [ count 1 nested 0 merged 0 ] 37 | fid_fileinfo 3 [ AutoLoader.pm 3 2 0 0 ] 38 | fid_fileinfo 4 [ (eval 0)[test14.pm (autosplit into auto/test14/bar.al):17] 2 17 4 2 0 0 ] 39 | fid_line_time 1 17 [ 0 1 ] 40 | fid_line_time 1 18 [ 0 1 ] 41 | fid_line_time 1 19 [ 0 1 ] 42 | fid_line_time 2 8 [ 0 1 ] 43 | fid_line_time 2 13 [ 0 1 ] 44 | fid_line_time 2 17 [ 0 2 ] 45 | fid_line_time 2 20 [ 0 1 ] 46 | fid_line_time 4 1 [ 0 1 ] 47 | fid_sub_time 1 17 [ 0 1 ] 48 | fid_sub_time 1 18 [ 0 1 ] 49 | fid_sub_time 1 19 [ 0 1 ] 50 | fid_sub_time 2 8 [ 0 1 ] 51 | fid_sub_time 2 13 [ 0 1 ] 52 | fid_sub_time 2 17 [ 0 2 ] 53 | fid_sub_time 2 20 [ 0 1 ] 54 | fid_sub_time 4 1 [ 0 1 ] 55 | profile_modes fid_block_time block 56 | profile_modes fid_line_time line 57 | profile_modes fid_sub_time sub 58 | sub_subinfo main::BEGIN [ 1:16-16 calls 0 times 0 0 0 0 ] 59 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 60 | sub_subinfo test14::BEGIN [ 2:2-2 calls 0 times 0 0 0 0 ] 61 | sub_subinfo test14::bar [ 2:16-18 calls 1 times 0 0 0 0 ] 62 | sub_subinfo test14::bar called_by 3:1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 63 | sub_subinfo test14::foo [ 2:12-14 calls 1 times 0 0 0 0 ] 64 | sub_subinfo test14::foo called_by 3:1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 65 | sub_subinfo test14::pre [ 2:8-8 calls 1 times 0 0 0 0 ] 66 | sub_subinfo test14::pre called_by 1:17 [ 1 0 0 0 0 0 0 main::RUNTIME ] 67 | -------------------------------------------------------------------------------- /t/test14.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | # hack to disable sawampersand test, just to simplify the testing across versions 8 | $ENV{DISABLE_NYTPROF_SAWAMPERSAND} = 1; 9 | 10 | run_test_group; 11 | -------------------------------------------------------------------------------- /t/test14.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# If the AutoSplit module has been loaded before we got initialized 5 | 0,0,0,# (specifically before we redirected the opcodes used when compiling) 6 | 0,0,0,# then the profiler won't profile AutoSplit code so the test will fail 7 | 0,0,0,# because the results won't match. 8 | 0,0,0,# The tricky part is that we need to take care to avoid being tripped up 9 | 0,0,0,# by the fact that XSLoader will fallback to using DynaLoader in some cases 10 | 0,0,0,# and DynaLoader uses AutoSplit. 11 | 0,0,0,# See Makefile.PL for how we avoid XSLoader fallback to using DynaLoader. 12 | 0,0,0, 13 | 0,0,0,BEGIN { 14 | 0,0,0,use AutoSplit; 15 | 0,0,0,mkdir('./auto'); 16 | 0,0,0,autosplit('test14', './auto', 1, 0, 0); 17 | 0,0,0,} 18 | 0,0,0, 19 | 0,0,0,use test14; 20 | 0,1,0,test14::pre(); 21 | 0,1,0,test14::foo(); 22 | 0,1,0,test14::bar(); 23 | -------------------------------------------------------------------------------- /t/test16.calls: -------------------------------------------------------------------------------- 1 | main::foo 2 2 | main::foo;main::CORE:match 3 3 | main::foo;main::CORE:say 2 4 | main::bar 2 5 | main::bar;main::CORE:match 3 6 | main::bar;main::CORE:print 2 7 | -------------------------------------------------------------------------------- /t/test16.p: -------------------------------------------------------------------------------- 1 | # tests given/when. Can only be tested by Perl 5.10 or later. 2 | 3 | use warnings; 4 | use strict; 5 | 6 | use feature ":5.10"; 7 | no if "$]" >= 5.018, warnings => "experimental"; 8 | 9 | sub foo { 10 | my $whameth = shift; 11 | given ($whameth) { 12 | when(/\d/) { 13 | say "number-like"; 14 | } 15 | when(/\w/) { 16 | say "word-like"; 17 | } 18 | } 19 | } 20 | 21 | sub bar { 22 | my $zlott = shift; 23 | if($zlott =~ /\d/) { 24 | print "number-like\n"; 25 | } elsif($zlott =~ /\w/) { 26 | print "word-like\n"; 27 | } 28 | } 29 | 30 | 31 | foo("baz"); 32 | foo(17); 33 | bar("baz"); 34 | bar(17); 35 | -------------------------------------------------------------------------------- /t/test16.rdt: -------------------------------------------------------------------------------- 1 | attribute application test16.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 10 [ 0 4 ] 18 | fid_block_time 1 11 [ 0 3 ] 19 | fid_block_time 1 22 [ 0 4 ] 20 | fid_block_time 1 31 [ 0 1 ] 21 | fid_block_time 1 32 [ 0 1 ] 22 | fid_block_time 1 33 [ 0 1 ] 23 | fid_block_time 1 34 [ 0 1 ] 24 | fid_fileinfo 1 [ test16.p 1 2 0 0 ] 25 | fid_fileinfo 1 sub main::BEGIN 7-7 26 | fid_fileinfo 1 sub main::CORE:match 0-0 27 | fid_fileinfo 1 sub main::CORE:print 0-0 28 | fid_fileinfo 1 sub main::CORE:say 0-0 29 | fid_fileinfo 1 sub main::RUNTIME 1-1 30 | fid_fileinfo 1 sub main::bar 21-28 31 | fid_fileinfo 1 sub main::foo 9-19 32 | fid_fileinfo 1 call 12 main::CORE:match [ 2 0 0 0 0 0 0 main::foo ] 33 | fid_fileinfo 1 call 12 main::CORE:say [ 1 0 0 0 0 0 0 main::foo ] 34 | fid_fileinfo 1 call 15 main::CORE:match [ 1 0 0 0 0 0 0 main::foo ] 35 | fid_fileinfo 1 call 15 main::CORE:say [ 1 0 0 0 0 0 0 main::foo ] 36 | fid_fileinfo 1 call 23 main::CORE:match [ 3 0 0 0 0 0 0 main::bar ] 37 | fid_fileinfo 1 call 23 main::CORE:print [ 2 0 0 0 0 0 0 main::bar ] 38 | fid_fileinfo 1 call 31 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 39 | fid_fileinfo 1 call 32 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_fileinfo 1 call 33 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | fid_fileinfo 1 call 34 main::bar [ 1 0 0 0 0 0 0 main::RUNTIME ] 42 | fid_line_time 1 10 [ 0 2 ] 43 | fid_line_time 1 11 [ 0 2 ] 44 | fid_line_time 1 12 [ 0 2 ] 45 | fid_line_time 1 15 [ 0 1 ] 46 | fid_line_time 1 22 [ 0 2 ] 47 | fid_line_time 1 23 [ 0 2 ] 48 | fid_line_time 1 31 [ 0 1 ] 49 | fid_line_time 1 32 [ 0 1 ] 50 | fid_line_time 1 33 [ 0 1 ] 51 | fid_line_time 1 34 [ 0 1 ] 52 | fid_sub_time 1 10 [ 0 7 ] 53 | fid_sub_time 1 22 [ 0 4 ] 54 | fid_sub_time 1 31 [ 0 1 ] 55 | fid_sub_time 1 32 [ 0 1 ] 56 | fid_sub_time 1 33 [ 0 1 ] 57 | fid_sub_time 1 34 [ 0 1 ] 58 | profile_modes fid_block_time block 59 | profile_modes fid_line_time line 60 | profile_modes fid_sub_time sub 61 | sub_subinfo main::BEGIN [ 1:7-7 calls 0 times 0 0 0 0 ] 62 | sub_subinfo main::CORE:match [ 1:0-0 calls 6 times 0 0 0 0 ] 63 | sub_subinfo main::CORE:match called_by 1:12 [ 2 0 0 0 0 0 0 main::foo ] 64 | sub_subinfo main::CORE:match called_by 1:15 [ 1 0 0 0 0 0 0 main::foo ] 65 | sub_subinfo main::CORE:match called_by 1:23 [ 3 0 0 0 0 0 0 main::bar ] 66 | sub_subinfo main::CORE:print [ 1:0-0 calls 2 times 0 0 0 0 ] 67 | sub_subinfo main::CORE:print called_by 1:23 [ 2 0 0 0 0 0 0 main::bar ] 68 | sub_subinfo main::CORE:say [ 1:0-0 calls 2 times 0 0 0 0 ] 69 | sub_subinfo main::CORE:say called_by 1:12 [ 1 0 0 0 0 0 0 main::foo ] 70 | sub_subinfo main::CORE:say called_by 1:15 [ 1 0 0 0 0 0 0 main::foo ] 71 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 72 | sub_subinfo main::bar [ 1:21-28 calls 2 times 0 0 0 0 ] 73 | sub_subinfo main::bar called_by 1:33 [ 1 0 0 0 0 0 0 main::RUNTIME ] 74 | sub_subinfo main::bar called_by 1:34 [ 1 0 0 0 0 0 0 main::RUNTIME ] 75 | sub_subinfo main::foo [ 1:9-19 calls 2 times 0 0 0 0 ] 76 | sub_subinfo main::foo called_by 1:31 [ 1 0 0 0 0 0 0 main::RUNTIME ] 77 | sub_subinfo main::foo called_by 1:32 [ 1 0 0 0 0 0 0 main::RUNTIME ] 78 | -------------------------------------------------------------------------------- /t/test16.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | #plan skip_all => "needs perl >= 5.10" unless $] >= 5.010; 8 | plan skip_all => "needs perl >= 5.10 and <= 5.36" 9 | unless ($] >= 5.010 and $] <= 5.036); 10 | 11 | run_test_group; 12 | -------------------------------------------------------------------------------- /t/test16.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# tests given/when. Can only be tested by Perl 5.10 or later. 5 | 0,0,0, 6 | 0,0,0,use warnings; 7 | 0,0,0,use strict; 8 | 0,0,0, 9 | 0,0,0,use feature ":5.10"; 10 | 0,0,0,no if "$]" >= 5.018, warnings => "experimental"; 11 | 0,0,0, 12 | 0,0,0,sub foo { 13 | 0,2,0,my $whameth = shift; 14 | 0,2,0,given ($whameth) { 15 | 0,2,0,when(/\d/) { 16 | 0,0,0,say "number-like"; 17 | 0,0,0,} 18 | 0,1,0,when(/\w/) { 19 | 0,0,0,say "word-like"; 20 | 0,0,0,} 21 | 0,0,0,} 22 | 0,0,0,} 23 | 0,0,0, 24 | 0,0,0,sub bar { 25 | 0,2,0,my $zlott = shift; 26 | 0,2,0,if($zlott =~ /\d/) { 27 | 0,0,0,print "number-like\n"; 28 | 0,0,0,} elsif($zlott =~ /\w/) { 29 | 0,0,0,print "word-like\n"; 30 | 0,0,0,} 31 | 0,0,0,} 32 | 0,0,0, 33 | 0,0,0, 34 | 0,1,0,foo("baz"); 35 | 0,1,0,foo(17); 36 | 0,1,0,bar("baz"); 37 | 0,1,0,bar(17); 38 | -------------------------------------------------------------------------------- /t/test17-goto.calls: -------------------------------------------------------------------------------- 1 | main::origin 1 2 | main::origin;main::other 1 3 | main::destination 1 4 | main::destination;main::other 1 5 | main::foo 1 6 | main::foo;main::bar 1 7 | -------------------------------------------------------------------------------- /t/test17-goto.p: -------------------------------------------------------------------------------- 1 | # test various forms of goto 2 | 3 | # simple in-line goto 4 | 5 | goto main_label; 6 | die "should not get here"; 7 | main_label:; 8 | 9 | sub other { } # stub for checking sub caller info 10 | 11 | # goto &sub 12 | 13 | sub origin { 14 | other(); 15 | goto &destination; 16 | } 17 | 18 | sub destination { 19 | other(); 20 | } 21 | 22 | origin(); 23 | 24 | # goto out of a sub 25 | 26 | sub bar { 27 | goto foo_label; 28 | } 29 | 30 | sub foo { 31 | bar(); 32 | foo_label:; 33 | } 34 | 35 | foo(); 36 | -------------------------------------------------------------------------------- /t/test17-goto.rdt: -------------------------------------------------------------------------------- 1 | attribute application test17-goto.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 5 [ 0 1 ] 18 | fid_block_time 1 7 [ 0 1 ] 19 | fid_block_time 1 9 [ 0 2 ] 20 | fid_block_time 1 14 [ 0 2 ] 21 | fid_block_time 1 19 [ 0 1 ] 22 | fid_block_time 1 22 [ 0 1 ] 23 | fid_block_time 1 27 [ 0 1 ] 24 | fid_block_time 1 31 [ 0 2 ] 25 | fid_block_time 1 35 [ 0 1 ] 26 | fid_fileinfo 1 [ test17-goto.p 1 2 0 0 ] 27 | fid_fileinfo 1 sub main::BEGIN 0-0 28 | fid_fileinfo 1 sub main::RUNTIME 1-1 29 | fid_fileinfo 1 sub main::bar 26-28 30 | fid_fileinfo 1 sub main::destination 18-20 31 | fid_fileinfo 1 sub main::foo 30-33 32 | fid_fileinfo 1 sub main::origin 13-16 33 | fid_fileinfo 1 sub main::other 9-9 34 | fid_fileinfo 1 call 14 main::other [ 1 0 0 0 0 0 0 main::origin ] 35 | fid_fileinfo 1 call 15 main::destination [ 1 0 0 0 0 0 0 main::RUNTIME ] 36 | fid_fileinfo 1 call 19 main::other [ 1 0 0 0 0 0 0 main::destination ] 37 | fid_fileinfo 1 call 22 main::origin [ 1 0 0 0 0 0 0 main::RUNTIME ] 38 | fid_fileinfo 1 call 31 main::bar [ 1 0 0 0 0 0 0 main::foo ] 39 | fid_fileinfo 1 call 35 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_line_time 1 5 [ 0 1 ] 41 | fid_line_time 1 7 [ 0 1 ] 42 | fid_line_time 1 9 [ 0 2 ] 43 | fid_line_time 1 14 [ 0 1 ] 44 | fid_line_time 1 15 [ 0 1 ] 45 | fid_line_time 1 19 [ 0 1 ] 46 | fid_line_time 1 22 [ 0 1 ] 47 | fid_line_time 1 27 [ 0 1 ] 48 | fid_line_time 1 31 [ 0 1 ] 49 | fid_line_time 1 32 [ 0 1 ] 50 | fid_line_time 1 35 [ 0 1 ] 51 | fid_sub_time 1 5 [ 0 1 ] 52 | fid_sub_time 1 7 [ 0 1 ] 53 | fid_sub_time 1 9 [ 0 2 ] 54 | fid_sub_time 1 14 [ 0 2 ] 55 | fid_sub_time 1 19 [ 0 1 ] 56 | fid_sub_time 1 22 [ 0 1 ] 57 | fid_sub_time 1 27 [ 0 1 ] 58 | fid_sub_time 1 31 [ 0 2 ] 59 | fid_sub_time 1 35 [ 0 1 ] 60 | profile_modes fid_block_time block 61 | profile_modes fid_line_time line 62 | profile_modes fid_sub_time sub 63 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 64 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 65 | sub_subinfo main::bar [ 1:26-28 calls 1 times 0 0 0 0 ] 66 | sub_subinfo main::bar called_by 1:31 [ 1 0 0 0 0 0 0 main::foo ] 67 | sub_subinfo main::destination [ 1:18-20 calls 1 times 0 0 0 0 ] 68 | sub_subinfo main::destination called_by 1:15 [ 1 0 0 0 0 0 0 main::RUNTIME ] 69 | sub_subinfo main::foo [ 1:30-33 calls 1 times 0 0 0 0 ] 70 | sub_subinfo main::foo called_by 1:35 [ 1 0 0 0 0 0 0 main::RUNTIME ] 71 | sub_subinfo main::origin [ 1:13-16 calls 1 times 0 0 0 0 ] 72 | sub_subinfo main::origin called_by 1:22 [ 1 0 0 0 0 0 0 main::RUNTIME ] 73 | sub_subinfo main::other [ 1:9-9 calls 2 times 0 0 0 0 ] 74 | sub_subinfo main::other called_by 1:14 [ 1 0 0 0 0 0 0 main::origin ] 75 | sub_subinfo main::other called_by 1:19 [ 1 0 0 0 0 0 0 main::destination ] 76 | -------------------------------------------------------------------------------- /t/test17-goto.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test18-goto2.calls: -------------------------------------------------------------------------------- 1 | Test18::longmess 1 2 | Test18::longmess_jmp 1 3 | Test18::longmess_real 1 4 | -------------------------------------------------------------------------------- /t/test18-goto2.p: -------------------------------------------------------------------------------- 1 | # Test Carp::Heavy's "swap subs out from under you with goto &sub" 2 | 3 | use lib 't'; 4 | 5 | package Test18; 6 | 7 | sub longmess { goto &longmess_jmp } 8 | 9 | sub longmess_jmp { 10 | # the required file deletes this longmess_jmp sub, while it's executing, 11 | # and replaces it with longmess_real, which we then goto into! 12 | require 'test18-goto2.pm'; # has to be require, not eval '...' 13 | goto &longmess_real; 14 | } 15 | 16 | longmess("Oops"); 17 | -------------------------------------------------------------------------------- /t/test18-goto2.pm: -------------------------------------------------------------------------------- 1 | package Test18; 2 | 3 | sub longmess_real { return "Heavy" } 4 | 5 | delete $Test18::{longmess_jmp}; 6 | *longmess_jmp = *longmess_real; 7 | 8 | my $dummy = $&; # also test sawampersand 9 | 10 | 1; 11 | -------------------------------------------------------------------------------- /t/test18-goto2.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test20-streval.calls: -------------------------------------------------------------------------------- 1 | main::foo 4 2 | main::foo;main::CORE:print 4 3 | -------------------------------------------------------------------------------- /t/test20-streval.p: -------------------------------------------------------------------------------- 1 | # test merging of sub calls from eval fids 2 | 3 | sub foo { print "foo\n" } 4 | 5 | my $code = 'foo()'; 6 | 7 | # call once from particular line 8 | eval $code; 9 | 10 | # call twice from the same line 11 | eval $code or die $@; eval $code or die $@; 12 | 13 | # once from an eval inside an eval 14 | eval "eval q{$code}"; 15 | -------------------------------------------------------------------------------- /t/test20-streval.rdt: -------------------------------------------------------------------------------- 1 | attribute application test20-streval.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 3 [ 0 4 ] 18 | fid_block_time 1 5 [ 0 1 ] 19 | fid_block_time 1 8 [ 0 1 ] 20 | fid_block_time 1 11 [ 0 2 ] 21 | fid_block_time 1 14 [ 0 1 ] 22 | fid_block_time 2 1 [ 0 1 ] 23 | fid_block_time 3 1 [ 0 1 ] 24 | fid_block_time 5 1 [ 0 1 ] 25 | fid_block_time 6 1 [ 0 1 ] 26 | fid_fileinfo 1 [ test20-streval.p 1 2 0 0 ] 27 | fid_fileinfo 1 sub main::BEGIN 0-0 28 | fid_fileinfo 1 sub main::CORE:print 0-0 29 | fid_fileinfo 1 sub main::RUNTIME 1-1 30 | fid_fileinfo 1 sub main::foo 3-3 31 | fid_fileinfo 1 call 3 main::CORE:print [ 4 0 0 0 0 0 0 main::foo ] 32 | fid_fileinfo 1 eval 8 [ count 1 nested 0 merged 0 ] 33 | fid_fileinfo 1 eval 11 [ count 1 nested 0 merged 1 ] 34 | fid_fileinfo 1 eval 14 [ count 1 nested 1 merged 0 ] 35 | fid_fileinfo 2 [ (eval 0)[test20-streval.p:8] 1 8 2 2 0 0 ] 36 | fid_fileinfo 2 call 1 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 37 | fid_fileinfo 3 [ (eval 0)[test20-streval.p:11] 1 11 3 2 0 0 ] 38 | fid_fileinfo 3 call 1 main::foo [ 2 0 0 0 0 0 0 main::RUNTIME ] 39 | fid_fileinfo 5 [ (eval 0)[test20-streval.p:14] 1 14 5 2 0 0 ] 40 | fid_fileinfo 5 eval 1 [ count 1 nested 0 merged 0 ] 41 | fid_fileinfo 6 [ (eval 0)[(eval 0)[test20-streval.p:14]:1] 5 1 6 2 0 0 ] 42 | fid_fileinfo 6 call 1 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 43 | fid_line_time 1 3 [ 0 4 ] 44 | fid_line_time 1 5 [ 0 1 ] 45 | fid_line_time 1 8 [ 0 1 ] 46 | fid_line_time 1 11 [ 0 2 ] 47 | fid_line_time 1 14 [ 0 1 ] 48 | fid_line_time 2 1 [ 0 1 ] 49 | fid_line_time 3 1 [ 0 2 ] 50 | fid_line_time 5 1 [ 0 1 ] 51 | fid_line_time 6 1 [ 0 1 ] 52 | fid_sub_time 1 3 [ 0 4 ] 53 | fid_sub_time 1 5 [ 0 1 ] 54 | fid_sub_time 1 8 [ 0 1 ] 55 | fid_sub_time 1 11 [ 0 2 ] 56 | fid_sub_time 1 14 [ 0 1 ] 57 | fid_sub_time 2 1 [ 0 1 ] 58 | fid_sub_time 3 1 [ 0 1 ] 59 | fid_sub_time 5 1 [ 0 1 ] 60 | fid_sub_time 6 1 [ 0 1 ] 61 | profile_modes fid_block_time block 62 | profile_modes fid_line_time line 63 | profile_modes fid_sub_time sub 64 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 65 | sub_subinfo main::CORE:print [ 1:0-0 calls 4 times 0 0 0 0 ] 66 | sub_subinfo main::CORE:print called_by 1:3 [ 4 0 0 0 0 0 0 main::foo ] 67 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 68 | sub_subinfo main::foo [ 1:3-3 calls 4 times 0 0 0 0 ] 69 | sub_subinfo main::foo called_by 2:1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 70 | sub_subinfo main::foo called_by 3:1 [ 2 0 0 0 0 0 0 main::RUNTIME ] 71 | sub_subinfo main::foo called_by 6:1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 72 | -------------------------------------------------------------------------------- /t/test20-streval.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | use Devel::NYTProf::Constants qw(NYTP_SCi_elements); 7 | 8 | run_test_group( { 9 | extra_test_count => 8 + (3 * 6), 10 | extra_test_code => sub { 11 | my ($profile, $env) = @_; 12 | 13 | # check sub callers from sub perspective 14 | my $subs = $profile->subname_subinfo_map; 15 | my $si = $subs->{'main::foo'}; 16 | ok $si; 17 | is $si->calls, 4; 18 | my $called_by_subnames = $si->called_by_subnames; 19 | ok $called_by_subnames; 20 | is_deeply [ keys %$called_by_subnames ], 21 | [ 'main::RUNTIME' ], 22 | 'should be called from only from main::RUNTIME'; 23 | 24 | my $callers = $si->caller_fid_line_places; 25 | ok $callers; 26 | #warn Data::Dumper::Dumper($callers); 27 | # two calls from evals on same line get collapsed 28 | my @fids = keys %$callers; 29 | is @fids, 3, 'should be called from 3 files'; 30 | is_deeply [ map { keys %$_ } values %$callers ], [ 1, 1, 1 ], 31 | 'should all be called from line 1'; 32 | my @sc = map { values %$_ } values %$callers; 33 | is_deeply [ map { scalar @$_ } @sc ], [ (NYTP_SCi_elements()) x 3], 34 | 'all sub calls infos should have all elements'; 35 | 36 | # check sub callers from file perspective 37 | for my $fid (@fids) { 38 | ok my $fi = $profile->fileinfo_of($fid); 39 | ok my $sub_call_lines = $fi->sub_call_lines; 40 | #warn Data::Dumper::Dumper($sub_call_lines); 41 | is keys %$sub_call_lines, 1; 42 | is keys %{$sub_call_lines->{1}}, 1; 43 | ok my $sc = $sub_call_lines->{1}{'main::foo'}; 44 | is @$sc, NYTP_SCi_elements(), 'si should have all elements'; 45 | } 46 | }, 47 | } ); 48 | -------------------------------------------------------------------------------- /t/test20-streval.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# test merging of sub calls from eval fids 5 | 0,0,0, 6 | 0,4,0,sub foo { print "foo\n" } 7 | 0,0,0, 8 | 0,1,0,my $code = 'foo()'; 9 | 0,0,0, 10 | 0,0,0,# call once from particular line 11 | 0,1,0,eval $code; 12 | 0,0,0, 13 | 0,0,0,# call twice from the same line 14 | 0,2,0,eval $code or die $@; eval $code or die $@; 15 | 0,0,0, 16 | 0,0,0,# once from an eval inside an eval 17 | 0,1,0,eval "eval q{$code}"; 18 | -------------------------------------------------------------------------------- /t/test21-streval3.calls: -------------------------------------------------------------------------------- 1 | main::CORE:sselect 3 2 | main::foo 3 3 | -------------------------------------------------------------------------------- /t/test21-streval3.p: -------------------------------------------------------------------------------- 1 | # test nested string evals 2 | 3 | 4 | sub foo { 1 } 5 | my $code = q{ 6 | select(undef,undef,undef,0.2); 7 | foo(); 8 | eval q{ 9 | select(undef,undef,undef,0.2); 10 | foo(); 11 | eval q{ 12 | select(undef,undef,undef,0.2); 13 | foo(); 14 | } 15 | } 16 | }; 17 | eval $code; 18 | -------------------------------------------------------------------------------- /t/test21-streval3.rdt: -------------------------------------------------------------------------------- 1 | attribute application test21-streval3.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 4 [ 0 3 ] 18 | fid_block_time 1 5 [ 0 1 ] 19 | fid_block_time 1 17 [ 0 1 ] 20 | fid_block_time 2 2 [ 0 1 ] 21 | fid_block_time 2 3 [ 0 1 ] 22 | fid_block_time 2 4 [ 0 1 ] 23 | fid_block_time 3 2 [ 0 1 ] 24 | fid_block_time 3 3 [ 0 1 ] 25 | fid_block_time 3 4 [ 0 1 ] 26 | fid_block_time 4 2 [ 0 1 ] 27 | fid_block_time 4 3 [ 0 1 ] 28 | fid_fileinfo 1 [ test21-streval3.p 1 2 0 0 ] 29 | fid_fileinfo 1 sub main::BEGIN 0-0 30 | fid_fileinfo 1 sub main::CORE:sselect 0-0 31 | fid_fileinfo 1 sub main::RUNTIME 1-1 32 | fid_fileinfo 1 sub main::foo 4-4 33 | fid_fileinfo 1 eval 17 [ count 1 nested 2 merged 0 ] 34 | fid_fileinfo 2 [ (eval 0)[test21-streval3.p:17] 1 17 2 2 0 0 ] 35 | fid_fileinfo 2 call 2 main::CORE:sselect [ 1 0 0 0 0 0 0 main::RUNTIME ] 36 | fid_fileinfo 2 call 3 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 37 | fid_fileinfo 2 eval 4 [ count 1 nested 1 merged 0 ] 38 | fid_fileinfo 3 [ (eval 0)[(eval 0)[test21-streval3.p:17]:4] 2 4 3 2 0 0 ] 39 | fid_fileinfo 3 call 2 main::CORE:sselect [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_fileinfo 3 call 3 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | fid_fileinfo 3 eval 4 [ count 1 nested 0 merged 0 ] 42 | fid_fileinfo 4 [ (eval 0)[(eval 0)[(eval 0)[test21-streval3.p:17]:4]:4] 3 4 4 2 0 0 ] 43 | fid_fileinfo 4 call 2 main::CORE:sselect [ 1 0 0 0 0 0 0 main::RUNTIME ] 44 | fid_fileinfo 4 call 3 main::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 45 | fid_line_time 1 4 [ 0 3 ] 46 | fid_line_time 1 5 [ 0 1 ] 47 | fid_line_time 1 17 [ 0 1 ] 48 | fid_line_time 2 2 [ 0 1 ] 49 | fid_line_time 2 3 [ 0 1 ] 50 | fid_line_time 2 4 [ 0 1 ] 51 | fid_line_time 3 2 [ 0 1 ] 52 | fid_line_time 3 3 [ 0 1 ] 53 | fid_line_time 3 4 [ 0 1 ] 54 | fid_line_time 4 2 [ 0 1 ] 55 | fid_line_time 4 3 [ 0 1 ] 56 | fid_sub_time 1 4 [ 0 3 ] 57 | fid_sub_time 1 5 [ 0 1 ] 58 | fid_sub_time 1 17 [ 0 1 ] 59 | fid_sub_time 2 2 [ 0 1 ] 60 | fid_sub_time 2 3 [ 0 1 ] 61 | fid_sub_time 2 4 [ 0 1 ] 62 | fid_sub_time 3 2 [ 0 1 ] 63 | fid_sub_time 3 3 [ 0 1 ] 64 | fid_sub_time 3 4 [ 0 1 ] 65 | fid_sub_time 4 2 [ 0 1 ] 66 | fid_sub_time 4 3 [ 0 1 ] 67 | profile_modes fid_block_time block 68 | profile_modes fid_line_time line 69 | profile_modes fid_sub_time sub 70 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 71 | sub_subinfo main::CORE:sselect [ 1:0-0 calls 3 times 0 0 0 0 ] 72 | sub_subinfo main::CORE:sselect called_by 2:2 [ 1 0 0 0 0 0 0 main::RUNTIME ] 73 | sub_subinfo main::CORE:sselect called_by 3:2 [ 1 0 0 0 0 0 0 main::RUNTIME ] 74 | sub_subinfo main::CORE:sselect called_by 4:2 [ 1 0 0 0 0 0 0 main::RUNTIME ] 75 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 76 | sub_subinfo main::foo [ 1:4-4 calls 3 times 0 0 0 0 ] 77 | sub_subinfo main::foo called_by 2:3 [ 1 0 0 0 0 0 0 main::RUNTIME ] 78 | sub_subinfo main::foo called_by 3:3 [ 1 0 0 0 0 0 0 main::RUNTIME ] 79 | sub_subinfo main::foo called_by 4:3 [ 1 0 0 0 0 0 0 main::RUNTIME ] 80 | -------------------------------------------------------------------------------- /t/test21-streval3.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test21-streval3.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# test nested string evals 5 | 0,0,0, 6 | 0,0,0, 7 | 0,3,0,sub foo { 1 } 8 | 0,1,0,my $code = q{ 9 | 0,0,0,select(undef,undef,undef,0.2); 10 | 0,0,0,foo(); 11 | 0,0,0,eval q{ 12 | 0,0,0,select(undef,undef,undef,0.2); 13 | 0,0,0,foo(); 14 | 0,0,0,eval q{ 15 | 0,0,0,select(undef,undef,undef,0.2); 16 | 0,0,0,foo(); 17 | 0,0,0,} 18 | 0,0,0,} 19 | 0,0,0,}; 20 | 0,1,0,eval $code; 21 | -------------------------------------------------------------------------------- /t/test22-strevala.calls: -------------------------------------------------------------------------------- 1 | main::__ANON__[(eval 0)[test22-strevala.p:6]:2] 1 2 | main::__ANON__[(eval 0)[test22-strevala.p:6]:2];main::CORE:print 1 3 | main::__ANON__[(eval 0)[test22-strevala.p:9]:2] 2 4 | main::__ANON__[(eval 0)[test22-strevala.p:9]:2];main::CORE:print 2 5 | main::__ANON__[(eval 0)[(eval 0)[test22-strevala.p:12]:2]:2] 2 6 | main::__ANON__[(eval 0)[(eval 0)[test22-strevala.p:12]:2]:2];main::CORE:print 2 7 | -------------------------------------------------------------------------------- /t/test22-strevala.p: -------------------------------------------------------------------------------- 1 | # test merging of anon subs from evals 2 | 3 | my $code = qq{ sub { print "sub called\n" } $Devel::NYTProf::StrEvalTestPad}; 4 | 5 | # call once from particular line 6 | eval($code)->(); 7 | 8 | # call twice from the same line 9 | eval($code)->(); eval($code)->(); 10 | 11 | # called from inside a string eval 12 | eval q{ 13 | eval($code)->(); eval($code)->(); 14 | }; 15 | -------------------------------------------------------------------------------- /t/test22-strevala.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use List::Util qw(sum); 5 | use lib qw(t/lib); 6 | use NYTProfTest; 7 | 8 | # don't normalize eval seqn because doing so would create duplicates 9 | $ENV{NYTPROF_TEST_SKIP_EVAL_NORM} = 1; 10 | 11 | use Devel::NYTProf::Constants qw(NYTP_SCi_elements); 12 | 13 | run_test_group( { 14 | extra_test_count => 2 + (3 * 3), 15 | extra_test_code => sub { 16 | my ($profile, $env) = @_; 17 | 18 | # check sub callers from sub perspective 19 | my $subs = $profile->subname_subinfo_map; 20 | my @anon = grep { $_->is_anon } values %$subs; 21 | is @anon, 3, 'should be 3 anon subs (after merging)'; 22 | is sum(map { $_->calls } @anon), 5, 'call count'; 23 | 24 | my %fids; 25 | for my $si (@anon) { 26 | printf "------ sub %s\n", $si->subname; 27 | my $called_by_subnames = $si->called_by_subnames; 28 | ok $called_by_subnames; 29 | is_deeply [ keys %$called_by_subnames ], 30 | [ 'main::RUNTIME' ], 31 | 'should be called from only from main::RUNTIME'; 32 | 33 | my $callers = $si->caller_fid_line_places; 34 | ok $callers; 35 | print "caller_fid_line_places: ".Data::Dumper::Dumper($callers); 36 | 37 | ++$fids{$_} for keys %$callers; 38 | } 39 | 40 | return; 41 | 42 | # check sub callers from file perspective 43 | for my $fid (keys %fids) { 44 | print "------ fid $fid\n"; 45 | ok my $fi = $profile->fileinfo_of($fid); 46 | ok my $sub_call_lines = $fi->sub_call_lines; 47 | warn "sub_call_lines: ".Data::Dumper::Dumper($sub_call_lines); 48 | is keys %$sub_call_lines, 1; 49 | is keys %{$sub_call_lines->{1}}, 1; 50 | ok my $sc = $sub_call_lines->{1}{'main::foo'}; 51 | is @$sc, NYTP_SCi_elements(), 'si should have all elements'; 52 | } 53 | }, 54 | } ); 55 | 56 | exit 0; 57 | 58 | __END__ 59 | my $code = 'sub { print "sub called\n" }'; 60 | eval($code)->(); 61 | eval($code)->(); eval($code)->(); 62 | eval q{ 63 | eval($code)->(); eval($code)->(); 64 | }; 65 | -------------------------------------------------------------------------------- /t/test23-strevall.calls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/timbunce/devel-nytprof/71b1fd5f676b46111b77ee0f718cf964081d20d3/t/test23-strevall.calls -------------------------------------------------------------------------------- /t/test23-strevall.p: -------------------------------------------------------------------------------- 1 | # test handling of string eval 'file names' that don't include the 2 | # invoking filename (normally added when $^P & 0x100 is true). 3 | 4 | shift; 5 | 6 | # fake an eval (using a #line directive) that doesn't match the 7 | # usual "(eval N)[file:line]" syntax: 8 | #line 42 "(eval 142)" 9 | # [stats for the line below won't appear in reports because as far as perl is 10 | # concerned the rest of this file isn't actually part of this file, but is 11 | # actually part of a file called "(eval 142)"] 12 | 242; 13 | -------------------------------------------------------------------------------- /t/test23-strevall.rdt: -------------------------------------------------------------------------------- 1 | attribute application test23-strevall.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 4 [ 0 1 ] 18 | fid_block_time 2 45 [ 0 1 ] 19 | fid_fileinfo 1 [ test23-strevall.p 1 2 0 0 ] 20 | fid_fileinfo 1 sub main::BEGIN 0-0 21 | fid_fileinfo 2 [ (eval 0) 3 1 2 2 0 0 ] 22 | fid_fileinfo 3 [ /unknown-eval-invoker 3 386 0 0 ] 23 | fid_fileinfo 3 eval 1 [ count 1 nested 0 merged 0 ] 24 | fid_line_time 1 4 [ 0 1 ] 25 | fid_line_time 2 45 [ 0 1 ] 26 | fid_sub_time 1 4 [ 0 1 ] 27 | fid_sub_time 2 45 [ 0 1 ] 28 | profile_modes fid_block_time block 29 | profile_modes fid_line_time line 30 | profile_modes fid_sub_time sub 31 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 32 | -------------------------------------------------------------------------------- /t/test23-strevall.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test24-strevalc.calls: -------------------------------------------------------------------------------- 1 | main::__ANON__[(eval 0)[test24-strevalc.p:8]:1] 2 2 | -------------------------------------------------------------------------------- /t/test24-strevalc.p: -------------------------------------------------------------------------------- 1 | # test 'collapsing' of string evals 2 | my @src = ( 3 | (("1+1") x 2), 4 | (("eval '1+1'") x 2), 5 | (("sub { 1 }->()") x 2), 6 | ); 7 | for my $src (@src) { 8 | eval $src; 9 | } 10 | -------------------------------------------------------------------------------- /t/test24-strevalc.rdt: -------------------------------------------------------------------------------- 1 | attribute application test24-strevalc.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 1 ] 18 | fid_block_time 1 7 [ 0 1 ] 19 | fid_block_time 1 8 [ 0 6 ] 20 | fid_block_time 2 1 [ 0 1 ] 21 | fid_block_time 4 1 [ 0 1 ] 22 | fid_block_time 5 1 [ 0 1 ] 23 | fid_block_time 6 1 [ 0 1 ] 24 | fid_block_time 7 1 [ 0 1 ] 25 | fid_block_time 8 1 [ 0 2 ] 26 | fid_fileinfo 1 [ test24-strevalc.p 1 2 0 0 ] 27 | fid_fileinfo 1 sub main::BEGIN 0-0 28 | fid_fileinfo 1 sub main::RUNTIME 1-1 29 | fid_fileinfo 1 eval 8 [ count 4 nested 2 merged 2 ] 30 | fid_fileinfo 2 [ (eval 1)[test24-strevalc.p:8] 1 8 2 2 0 0 ] 31 | fid_fileinfo 4 [ (eval 3)[test24-strevalc.p:8] 1 8 4 2 0 0 ] 32 | fid_fileinfo 4 eval 1 [ count 1 nested 0 merged 0 ] 33 | fid_fileinfo 5 [ (eval 4)[(eval 3)[test24-strevalc.p:8]:1] 4 1 5 2 0 0 ] 34 | fid_fileinfo 6 [ (eval 5)[test24-strevalc.p:8] 1 8 6 2 0 0 ] 35 | fid_fileinfo 6 eval 1 [ count 1 nested 0 merged 0 ] 36 | fid_fileinfo 7 [ (eval 6)[(eval 5)[test24-strevalc.p:8]:1] 6 1 7 2 0 0 ] 37 | fid_fileinfo 8 [ (eval 7)[test24-strevalc.p:8] 1 8 8 2 0 0 ] 38 | fid_fileinfo 8 sub main::__ANON__[(eval 7)[test24-strevalc.p:8]:1] 1-1 39 | fid_fileinfo 8 call 1 main::__ANON__[(eval 7)[test24-strevalc.p:8]:1] [ 2 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_line_time 1 2 [ 0 1 ] 41 | fid_line_time 1 7 [ 0 1 ] 42 | fid_line_time 1 8 [ 0 6 ] 43 | fid_line_time 2 1 [ 0 2 ] 44 | fid_line_time 4 1 [ 0 1 ] 45 | fid_line_time 5 1 [ 0 1 ] 46 | fid_line_time 6 1 [ 0 1 ] 47 | fid_line_time 7 1 [ 0 1 ] 48 | fid_line_time 8 1 [ 0 4 ] 49 | fid_sub_time 1 2 [ 0 1 ] 50 | fid_sub_time 1 7 [ 0 1 ] 51 | fid_sub_time 1 8 [ 0 6 ] 52 | fid_sub_time 2 1 [ 0 1 ] 53 | fid_sub_time 4 1 [ 0 1 ] 54 | fid_sub_time 5 1 [ 0 1 ] 55 | fid_sub_time 6 1 [ 0 1 ] 56 | fid_sub_time 7 1 [ 0 1 ] 57 | fid_sub_time 8 1 [ 0 2 ] 58 | profile_modes fid_block_time block 59 | profile_modes fid_line_time line 60 | profile_modes fid_sub_time sub 61 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 62 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 63 | sub_subinfo main::__ANON__[(eval 7)[test24-strevalc.p:8]:1] [ 8:1-1 calls 2 times 0 0 0 0 ] 64 | sub_subinfo main::__ANON__[(eval 7)[test24-strevalc.p:8]:1] called_by 8:1 [ 2 0 0 0 0 0 0 main::RUNTIME ] 65 | sub_subinfo main::__ANON__[(eval 7)[test24-strevalc.p:8]:1] merge_donor main::__ANON__[(eval 8)[test24-strevalc.p:8]:1] 66 | -------------------------------------------------------------------------------- /t/test24-strevalc.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | $ENV{NYTPROF_TEST_SKIP_EVAL_NORM} = 1; 8 | 9 | run_test_group; 10 | -------------------------------------------------------------------------------- /t/test25-strevalb.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests CORE::GLOBAL::foo plus assorted data model methods 4 | 5 | use Test::More; 6 | 7 | use lib qw(t/lib); 8 | use NYTProfTest; 9 | use Config qw(%Config); 10 | 11 | use Devel::NYTProf::Run qw(profile_this); 12 | use Devel::NYTProf::Constants qw(NYTP_SCi_elements); 13 | 14 | my $pre589 = ($] < 5.008009 or $] eq "5.010000"); 15 | 16 | my $src_code = join("", ); 17 | 18 | # perl assert failure https://rt.perl.org/Ticket/Display.html?id=122771 19 | my $perl_rt70211 = ($] >= 5.020 && $Config{ccflags} =~ /-DDEBUGGING/); 20 | 21 | run_test_group( { 22 | extra_options => { 23 | start => 'begin', 24 | optimize => ($perl_rt70211) ? 0 : 1, 25 | }, 26 | extra_test_count => 8, 27 | extra_test_code => sub { 28 | my ($profile, $env) = @_; 29 | 30 | $profile = profile_this( 31 | src_code => $src_code, 32 | out_file => $env->{file}, 33 | skip_sitecustomize => 1, 34 | ); 35 | isa_ok $profile, 'Devel::NYTProf::Data'; 36 | 37 | my $fi = $profile->fileinfo_of(1); 38 | my $subdefs_at_line = $profile->subs_defined_in_file_by_line($fi->filename); 39 | # 0: version::(bool, 1: main::BEGIN@1, 2: main::BEGIN@2, 3: main::add, 4: main::inc 40 | #warn join ", ", map { "$_: ".$subdefs_at_line->{$_}[0]->subname } sort keys %$subdefs_at_line; 41 | isa_ok my $add_si = $subdefs_at_line->{4}[0], 'Devel::NYTProf::SubInfo'; 42 | is $add_si->subname, 'main::add'; 43 | 44 | my $callers = $add_si->caller_fid_line_places; 45 | 46 | is keys %$callers, 1, 'called from 1 fid'; 47 | my $caller_fid = (keys %$callers)[0]; 48 | my $sc_lineinfo = $callers->{$caller_fid}; 49 | is keys %$sc_lineinfo, 1, 'called from 1 line in that fid'; 50 | my $caller_line = (keys %$sc_lineinfo)[0]; 51 | 52 | my $sc = (values %$sc_lineinfo)[0]; 53 | is ref $sc, 'ARRAY'; 54 | is @$sc, NYTP_SCi_elements(), "call from $caller_fid:$caller_line to main::add should have all elements in $sc"; 55 | 56 | my $called_by_subnames = $add_si->called_by_subnames; 57 | is keys %$called_by_subnames, 1, 'called_by_subnames should report one caller for main::add'; 58 | }, 59 | }); 60 | 61 | __DATA__ 62 | use strict; 63 | use Benchmark; 64 | my $i; 65 | sub add { ++$i } 66 | timethis( 10, \&add ); 67 | die "panic $i" unless $i == 10; 68 | -------------------------------------------------------------------------------- /t/test30-fork-0.calls: -------------------------------------------------------------------------------- 1 | main::other 1 2 | main::other;main::CORE:print 1 3 | main::prefork 1 4 | main::prefork;main::CORE:print 1 5 | main::prefork;main::other 1 6 | main::prefork;main::other;main::CORE:print 1 7 | main::postfork 1 8 | main::postfork;main::CORE:print 1 9 | main::postfork;main::other 1 10 | main::postfork;main::other;main::CORE:print 1 11 | main::CORE:wait 1 12 | -------------------------------------------------------------------------------- /t/test30-fork-0.p: -------------------------------------------------------------------------------- 1 | sub prefork { 2 | print "in sub prefork\n"; 3 | other(); 4 | } 5 | 6 | sub other { 7 | print "in sub other\n"; 8 | } 9 | 10 | sub postfork { 11 | print "in sub postfork\n"; 12 | other(); 13 | } 14 | 15 | prefork(); 16 | 17 | fork; 18 | 19 | postfork(); 20 | other(); 21 | 22 | wait; 23 | -------------------------------------------------------------------------------- /t/test30-fork-0.rdt: -------------------------------------------------------------------------------- 1 | attribute application test30-fork-0.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 2 ] 18 | fid_block_time 1 7 [ 0 3 ] 19 | fid_block_time 1 11 [ 0 2 ] 20 | fid_block_time 1 15 [ 0 1 ] 21 | fid_block_time 1 17 [ 0 1 ] 22 | fid_block_time 1 19 [ 0 1 ] 23 | fid_block_time 1 20 [ 0 1 ] 24 | fid_block_time 1 22 [ 0 1 ] 25 | fid_fileinfo 1 [ test30-fork-0.p 1 2 0 0 ] 26 | fid_fileinfo 1 sub main::BEGIN 0-0 27 | fid_fileinfo 1 sub main::CORE:print 0-0 28 | fid_fileinfo 1 sub main::CORE:wait 0-0 29 | fid_fileinfo 1 sub main::RUNTIME 1-1 30 | fid_fileinfo 1 sub main::other 6-8 31 | fid_fileinfo 1 sub main::postfork 10-13 32 | fid_fileinfo 1 sub main::prefork 1-4 33 | fid_fileinfo 1 call 2 main::CORE:print [ 1 0 0 0 0 0 0 main::prefork ] 34 | fid_fileinfo 1 call 3 main::other [ 1 0 0 0 0 0 0 main::prefork ] 35 | fid_fileinfo 1 call 7 main::CORE:print [ 3 0 0 0 0 0 0 main::other ] 36 | fid_fileinfo 1 call 11 main::CORE:print [ 1 0 0 0 0 0 0 main::postfork ] 37 | fid_fileinfo 1 call 12 main::other [ 1 0 0 0 0 0 0 main::postfork ] 38 | fid_fileinfo 1 call 15 main::prefork [ 1 0 0 0 0 0 0 main::RUNTIME ] 39 | fid_fileinfo 1 call 19 main::postfork [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | fid_fileinfo 1 call 20 main::other [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | fid_fileinfo 1 call 22 main::CORE:wait [ 1 0 0 0 0 0 0 main::RUNTIME ] 42 | fid_line_time 1 2 [ 0 1 ] 43 | fid_line_time 1 3 [ 0 1 ] 44 | fid_line_time 1 7 [ 0 3 ] 45 | fid_line_time 1 11 [ 0 1 ] 46 | fid_line_time 1 12 [ 0 1 ] 47 | fid_line_time 1 15 [ 0 1 ] 48 | fid_line_time 1 17 [ 0 1 ] 49 | fid_line_time 1 19 [ 0 1 ] 50 | fid_line_time 1 20 [ 0 1 ] 51 | fid_line_time 1 22 [ 0 1 ] 52 | fid_sub_time 1 2 [ 0 2 ] 53 | fid_sub_time 1 7 [ 0 3 ] 54 | fid_sub_time 1 11 [ 0 2 ] 55 | fid_sub_time 1 15 [ 0 1 ] 56 | fid_sub_time 1 17 [ 0 1 ] 57 | fid_sub_time 1 19 [ 0 1 ] 58 | fid_sub_time 1 20 [ 0 1 ] 59 | fid_sub_time 1 22 [ 0 1 ] 60 | profile_modes fid_block_time block 61 | profile_modes fid_line_time line 62 | profile_modes fid_sub_time sub 63 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 64 | sub_subinfo main::CORE:print [ 1:0-0 calls 5 times 0 0 0 0 ] 65 | sub_subinfo main::CORE:print called_by 1:2 [ 1 0 0 0 0 0 0 main::prefork ] 66 | sub_subinfo main::CORE:print called_by 1:7 [ 3 0 0 0 0 0 0 main::other ] 67 | sub_subinfo main::CORE:print called_by 1:11 [ 1 0 0 0 0 0 0 main::postfork ] 68 | sub_subinfo main::CORE:wait [ 1:0-0 calls 1 times 0 0 0 0 ] 69 | sub_subinfo main::CORE:wait called_by 1:22 [ 1 0 0 0 0 0 0 main::RUNTIME ] 70 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 71 | sub_subinfo main::other [ 1:6-8 calls 3 times 0 0 0 0 ] 72 | sub_subinfo main::other called_by 1:3 [ 1 0 0 0 0 0 0 main::prefork ] 73 | sub_subinfo main::other called_by 1:12 [ 1 0 0 0 0 0 0 main::postfork ] 74 | sub_subinfo main::other called_by 1:20 [ 1 0 0 0 0 0 0 main::RUNTIME ] 75 | sub_subinfo main::postfork [ 1:10-13 calls 1 times 0 0 0 0 ] 76 | sub_subinfo main::postfork called_by 1:19 [ 1 0 0 0 0 0 0 main::RUNTIME ] 77 | sub_subinfo main::prefork [ 1:1-4 calls 1 times 0 0 0 0 ] 78 | sub_subinfo main::prefork called_by 1:15 [ 1 0 0 0 0 0 0 main::RUNTIME ] 79 | -------------------------------------------------------------------------------- /t/test30-fork-0.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | plan skip_all => "doesn't work with fork() emulation" if (($^O eq "MSWin32") || ($^O eq 'VMS')); 8 | 9 | run_test_group; 10 | -------------------------------------------------------------------------------- /t/test30-fork-0.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,sub prefork { 5 | 0,1,0,print "in sub prefork\n"; 6 | 0,1,0,other(); 7 | 0,0,0,} 8 | 0,0,0, 9 | 0,0,0,sub other { 10 | 0,3,0,print "in sub other\n"; 11 | 0,0,0,} 12 | 0,0,0, 13 | 0,0,0,sub postfork { 14 | 0,1,0,print "in sub postfork\n"; 15 | 0,1,0,other(); 16 | 0,0,0,} 17 | 0,0,0, 18 | 0,1,0,prefork(); 19 | 0,0,0, 20 | 0,1,0,fork; 21 | 0,0,0, 22 | 0,1,0,postfork(); 23 | 0,1,0,other(); 24 | 0,0,0, 25 | 0,1,0,wait; 26 | -------------------------------------------------------------------------------- /t/test30-fork-1.rdt: -------------------------------------------------------------------------------- 1 | attribute application test30-fork.0.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute nv_size 0 5 | attribute perl_version 0 6 | attribute profiler_duration 0 7 | attribute profiler_end_time 0 8 | attribute profiler_start_time 0 9 | attribute ticks_per_sec 0 10 | attribute total_stmts_discounted 0 11 | attribute total_stmts_duration 0 12 | attribute total_stmts_measured 0 13 | attribute total_sub_calls 0 14 | attribute xs_version 0 15 | fid_block_time 1 7 [ 0 2 ] 16 | fid_block_time 1 11 [ 0 2 ] 17 | fid_block_time 1 19 [ 0 1 ] 18 | fid_block_time 1 20 [ 0 1 ] 19 | fid_block_time 1 22 [ 0 1 ] 20 | fid_fileinfo 1 [ test30-fork.0.p 1 2 0 0 ] 21 | fid_fileinfo 1 sub main::other 6-8 22 | fid_fileinfo 1 sub main::postfork 10-13 23 | fid_fileinfo 1 sub main::prefork 1-4 24 | fid_fileinfo 1 call 12 main::other [ 1 0 0 0 0 0 0 ] 25 | fid_fileinfo 1 call 19 main::postfork [ 1 0 0 0 0 0 0 ] 26 | fid_fileinfo 1 call 20 main::other [ 1 0 0 0 0 0 0 ] 27 | fid_line_time 1 7 [ 0 2 ] 28 | fid_line_time 1 11 [ 0 1 ] 29 | fid_line_time 1 12 [ 0 1 ] 30 | fid_line_time 1 19 [ 0 1 ] 31 | fid_line_time 1 20 [ 0 1 ] 32 | fid_line_time 1 22 [ 0 1 ] 33 | fid_sub_time 1 7 [ 0 2 ] 34 | fid_sub_time 1 11 [ 0 2 ] 35 | fid_sub_time 1 19 [ 0 1 ] 36 | fid_sub_time 1 20 [ 0 1 ] 37 | fid_sub_time 1 22 [ 0 1 ] 38 | profile_modes fid_block_time block 39 | profile_modes fid_line_time line 40 | profile_modes fid_sub_time sub 41 | sub_subinfo main::other [ 1 6 8 2 0 0 0 0 ] 42 | sub_subinfo main::other called_by 1 12 [ 1 0 0 0 0 0 0 ] 43 | sub_subinfo main::other called_by 1 20 [ 1 0 0 0 0 0 0 ] 44 | sub_subinfo main::postfork [ 1 10 13 1 0 0 0 0 ] 45 | sub_subinfo main::postfork called_by 1 19 [ 1 0 0 0 0 0 0 ] 46 | sub_subinfo main::prefork [ 1 1 4 0 0 0 0 0 ] 47 | -------------------------------------------------------------------------------- /t/test30-fork-1.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,sub prefork { 5 | 0,0,0,print "in sub prefork\n"; 6 | 0,0,0,other(); 7 | 0,0,0,} 8 | 0,0,0, 9 | 0,0,0,sub other { 10 | 0,2,0,print "in sub other\n"; 11 | 0,0,0,} 12 | 0,0,0, 13 | 0,0,0,sub postfork { 14 | 0,1,0,print "in sub postfork\n"; 15 | 0,1,0,other(); 16 | 0,0,0,} 17 | 0,0,0, 18 | 0,0,0,prefork(); 19 | 0,0,0, 20 | 0,0,0,fork; 21 | 0,0,0, 22 | 0,1,0,postfork(); 23 | 0,1,0,other(); 24 | 0,0,0, 25 | 0,1,0,wait; 26 | -------------------------------------------------------------------------------- /t/test40pmc.calls: -------------------------------------------------------------------------------- 1 | test40pmc::foo 1 2 | -------------------------------------------------------------------------------- /t/test40pmc.p: -------------------------------------------------------------------------------- 1 | # test test40pmc.pmc is loaded instead of test40pmc.pm 2 | # (which requires test40pmc.pmc to be newer, which Makefile.PL arranges) 3 | use test40pmc; 4 | test40pmc::foo(); 5 | -------------------------------------------------------------------------------- /t/test40pmc.pm: -------------------------------------------------------------------------------- 1 | # this test14.pm file should not be loaded because the test14.pmc 2 | # file should be newer and so that's the one that perl will use 3 | die sprintf q{%s used in error. The %sc file needs to be newer so perl will use the .pmc instead. 4 | }, __FILE__, __FILE__; 5 | -------------------------------------------------------------------------------- /t/test40pmc.pm_x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# this is test14.pmc which perl will load in preference to test14.pmc 5 | 0,0,0,# (if it's newer than test14.pm) 6 | 0,0,0,package test40pmc; 7 | 0,0,0, 8 | 0,0,0,sub foo { 9 | 0,1,0,1; 10 | 0,0,0,} 11 | 0,0,0, 12 | 0,0,0,1; 13 | -------------------------------------------------------------------------------- /t/test40pmc.pmc: -------------------------------------------------------------------------------- 1 | # this is test14.pmc which perl will load in preference to test14.pmc 2 | # (if it's newer than test14.pm) 3 | package test40pmc; 4 | 5 | sub foo { 6 | 1; 7 | } 8 | 9 | 1; 10 | -------------------------------------------------------------------------------- /t/test40pmc.rdt: -------------------------------------------------------------------------------- 1 | attribute application test40pmc.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 4 [ 0 1 ] 18 | fid_block_time 2 6 [ 0 1 ] 19 | fid_fileinfo 1 [ test40pmc.p 1 2 0 0 ] 20 | fid_fileinfo 1 sub main::BEGIN 3-3 21 | fid_fileinfo 1 sub main::RUNTIME 1-1 22 | fid_fileinfo 1 call 4 test40pmc::foo [ 1 0 0 0 0 0 0 main::RUNTIME ] 23 | fid_fileinfo 2 [ test40pmc.pm 2 3 0 0 ] 24 | fid_fileinfo 2 sub test40pmc::foo 5-7 25 | fid_line_time 1 4 [ 0 1 ] 26 | fid_line_time 2 6 [ 0 1 ] 27 | fid_sub_time 1 4 [ 0 1 ] 28 | fid_sub_time 2 6 [ 0 1 ] 29 | profile_modes fid_block_time block 30 | profile_modes fid_line_time line 31 | profile_modes fid_sub_time sub 32 | sub_subinfo main::BEGIN [ 1:3-3 calls 0 times 0 0 0 0 ] 33 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 34 | sub_subinfo test40pmc::foo [ 2:5-7 calls 1 times 0 0 0 0 ] 35 | sub_subinfo test40pmc::foo called_by 1:4 [ 1 0 0 0 0 0 0 main::RUNTIME ] 36 | -------------------------------------------------------------------------------- /t/test40pmc.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use Config; 5 | 6 | my $no_pmc; 7 | if (Config->can('non_bincompat_options')) { 8 | foreach(Config::non_bincompat_options()) { 9 | if($_ eq "PERL_DISABLE_PMC"){ 10 | $no_pmc = 1; 11 | last; 12 | } 13 | } 14 | }; 15 | plan skip_all => ".pmc are disabled in this perl" 16 | if $no_pmc; 17 | use lib qw(t/lib); 18 | use NYTProfTest; 19 | 20 | run_test_group; 21 | -------------------------------------------------------------------------------- /t/test40pmc.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# test test40pmc.pmc is loaded instead of test40pmc.pm 5 | 0,0,0,# (which requires test40pmc.pmc to be newer, which Makefile.PL arranges) 6 | 0,0,0,use test40pmc; 7 | 0,1,0,test40pmc::foo(); 8 | -------------------------------------------------------------------------------- /t/test50-disable.calls: -------------------------------------------------------------------------------- 1 | DB::disable_profile 2 2 | -------------------------------------------------------------------------------- /t/test50-disable.p: -------------------------------------------------------------------------------- 1 | shift; 2 | DB::disable_profile(); 3 | shift; 4 | DB::enable_profile(); 5 | shift; 6 | DB::disable_profile(); 7 | shift; # finish with profile disabled 8 | -------------------------------------------------------------------------------- /t/test50-disable.rdt: -------------------------------------------------------------------------------- 1 | attribute application test50-disable.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 1 [ 0 1 ] 18 | fid_block_time 1 2 [ 0 1 ] 19 | fid_block_time 1 4 [ 0 1 ] 20 | fid_block_time 1 5 [ 0 1 ] 21 | fid_fileinfo 1 [ test50-disable.p 1 2 0 0 ] 22 | fid_fileinfo 1 sub DB::disable_profile 0-0 23 | fid_fileinfo 1 sub main::BEGIN 0-0 24 | fid_fileinfo 1 sub main::RUNTIME 1-1 25 | fid_fileinfo 1 call 2 DB::disable_profile [ 1 0 0 0 0 0 0 main::RUNTIME ] 26 | fid_fileinfo 1 call 6 DB::disable_profile [ 1 0 0 0 0 0 0 main::RUNTIME ] 27 | fid_line_time 1 1 [ 0 1 ] 28 | fid_line_time 1 2 [ 0 1 ] 29 | fid_line_time 1 4 [ 0 1 ] 30 | fid_line_time 1 5 [ 0 1 ] 31 | fid_sub_time 1 1 [ 0 1 ] 32 | fid_sub_time 1 2 [ 0 1 ] 33 | fid_sub_time 1 4 [ 0 1 ] 34 | fid_sub_time 1 5 [ 0 1 ] 35 | profile_modes fid_block_time block 36 | profile_modes fid_line_time line 37 | profile_modes fid_sub_time sub 38 | sub_subinfo DB::disable_profile [ 1:0-0 calls 2 times 0 0 0 0 ] 39 | sub_subinfo DB::disable_profile called_by 1:2 [ 1 0 0 0 0 0 0 main::RUNTIME ] 40 | sub_subinfo DB::disable_profile called_by 1:6 [ 1 0 0 0 0 0 0 main::RUNTIME ] 41 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 42 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 43 | -------------------------------------------------------------------------------- /t/test50-disable.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test50-disable.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,1,0,shift; 5 | 0,1,0,DB::disable_profile(); 6 | 0,0,0,shift; 7 | 0,1,0,DB::enable_profile(); 8 | 0,1,0,shift; 9 | 0,0,0,DB::disable_profile(); 10 | 0,0,0,shift; # finish with profile disabled 11 | -------------------------------------------------------------------------------- /t/test51-enable.calls: -------------------------------------------------------------------------------- 1 | main::CORE:unlink 1 2 | main::sub1 1 3 | DB::disable_profile 1 4 | -------------------------------------------------------------------------------- /t/test51-enable.p: -------------------------------------------------------------------------------- 1 | # test using enable_profile() to write multiple profile files 2 | 3 | my $file_b = "nytprof-test51-b.out"; 4 | my $file_c = "nytprof-test51-c.out"; 5 | unlink $file_b, $file_c; 6 | 7 | sub sub1 { 1 } 8 | sub sub2 { 1 } 9 | sub sub3 { 1 } 10 | sub sub4 { 1 } 11 | sub sub5 { 1 } 12 | sub sub6 { 1 } 13 | sub sub7 { 1 } 14 | sub sub8 { 1 } 15 | 16 | sub1(); # profiled 17 | 18 | DB::disable_profile(); # also tests that sub1() call timing has completed 19 | 20 | sub2(); # not profiled 21 | 22 | # switch to new file and (re)enable profiling 23 | # the new file includes accumulated fid and subs-called data 24 | DB::enable_profile($file_b); 25 | 26 | sub3(); # profiled 27 | 28 | DB::finish_profile(); 29 | die "$file_b should exist" unless -s $file_b; 30 | 31 | sub4(); # not profiled 32 | 33 | # enable to new file 34 | DB::enable_profile($file_c); 35 | 36 | sub5(); # profiled but file will be overwritten by enable_profile() below 37 | 38 | DB::finish_profile(); 39 | 40 | sub6(); # not profiled 41 | 42 | DB::enable_profile(); # enable to current file 43 | 44 | sub7(); # profiled 45 | 46 | DB::finish_profile(); 47 | 48 | # This can be removed once we have a better test harness 49 | -f $_ or die "$_ should exist" for ($file_b, $file_c); 50 | 51 | # TODO should test for enable/disable within subs 52 | -------------------------------------------------------------------------------- /t/test51-enable.rdt: -------------------------------------------------------------------------------- 1 | attribute application test51-enable.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 3 [ 0 1 ] 18 | fid_block_time 1 4 [ 0 1 ] 19 | fid_block_time 1 5 [ 0 1 ] 20 | fid_block_time 1 7 [ 0 1 ] 21 | fid_block_time 1 16 [ 0 1 ] 22 | fid_fileinfo 1 [ test51-enable.p 1 2 0 0 ] 23 | fid_fileinfo 1 sub DB::disable_profile 0-0 24 | fid_fileinfo 1 sub main::BEGIN 0-0 25 | fid_fileinfo 1 sub main::CORE:unlink 0-0 26 | fid_fileinfo 1 sub main::RUNTIME 1-1 27 | fid_fileinfo 1 sub main::sub1 7-7 28 | fid_fileinfo 1 sub main::sub2 8-8 29 | fid_fileinfo 1 sub main::sub3 9-9 30 | fid_fileinfo 1 sub main::sub4 10-10 31 | fid_fileinfo 1 sub main::sub5 11-11 32 | fid_fileinfo 1 sub main::sub6 12-12 33 | fid_fileinfo 1 sub main::sub7 13-13 34 | fid_fileinfo 1 sub main::sub8 14-14 35 | fid_fileinfo 1 call 5 main::CORE:unlink [ 1 0 0 0 0 0 0 main::RUNTIME ] 36 | fid_fileinfo 1 call 16 main::sub1 [ 1 0 0 0 0 0 0 main::RUNTIME ] 37 | fid_fileinfo 1 call 18 DB::disable_profile [ 1 0 0 0 0 0 0 main::RUNTIME ] 38 | fid_line_time 1 3 [ 0 1 ] 39 | fid_line_time 1 4 [ 0 1 ] 40 | fid_line_time 1 5 [ 0 1 ] 41 | fid_line_time 1 7 [ 0 1 ] 42 | fid_line_time 1 16 [ 0 1 ] 43 | fid_sub_time 1 3 [ 0 1 ] 44 | fid_sub_time 1 4 [ 0 1 ] 45 | fid_sub_time 1 5 [ 0 1 ] 46 | fid_sub_time 1 7 [ 0 1 ] 47 | fid_sub_time 1 16 [ 0 1 ] 48 | profile_modes fid_block_time block 49 | profile_modes fid_line_time line 50 | profile_modes fid_sub_time sub 51 | sub_subinfo DB::disable_profile [ 1:0-0 calls 1 times 0 0 0 0 ] 52 | sub_subinfo DB::disable_profile called_by 1:18 [ 1 0 0 0 0 0 0 main::RUNTIME ] 53 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 54 | sub_subinfo main::CORE:unlink [ 1:0-0 calls 1 times 0 0 0 0 ] 55 | sub_subinfo main::CORE:unlink called_by 1:5 [ 1 0 0 0 0 0 0 main::RUNTIME ] 56 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 57 | sub_subinfo main::sub1 [ 1:7-7 calls 1 times 0 0 0 0 ] 58 | sub_subinfo main::sub1 called_by 1:16 [ 1 0 0 0 0 0 0 main::RUNTIME ] 59 | sub_subinfo main::sub2 [ 1:8-8 calls 0 times 0 0 0 0 ] 60 | sub_subinfo main::sub3 [ 1:9-9 calls 0 times 0 0 0 0 ] 61 | sub_subinfo main::sub4 [ 1:10-10 calls 0 times 0 0 0 0 ] 62 | sub_subinfo main::sub5 [ 1:11-11 calls 0 times 0 0 0 0 ] 63 | sub_subinfo main::sub6 [ 1:12-12 calls 0 times 0 0 0 0 ] 64 | sub_subinfo main::sub7 [ 1:13-13 calls 0 times 0 0 0 0 ] 65 | sub_subinfo main::sub8 [ 1:14-14 calls 0 times 0 0 0 0 ] 66 | -------------------------------------------------------------------------------- /t/test51-enable.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group({ 8 | extra_test_count => 3, 9 | extra_test_code => sub { 10 | my ($profile, $env) = @_; 11 | 12 | is_deeply(sub_calls($profile), { 13 | 'main::sub1' => 1, 14 | 'DB::disable_profile' => 1, 15 | 'main::CORE:unlink' => 1, 16 | }); 17 | 18 | my $file_b = "nytprof-test51-b.out"; 19 | my $file_c = "nytprof-test51-c.out"; 20 | 21 | my $pb = Devel::NYTProf::Data->new( { filename => $file_b, quiet => 0 } ); 22 | is_deeply(sub_calls($pb), { 23 | 'main::sub1' => 1, 24 | 'main::sub3' => 1, 25 | 'DB::disable_profile' => 1, 26 | 'main::CORE:unlink' => 1, 27 | }, "$file_b sub calls"); 28 | 29 | my $pc = Devel::NYTProf::Data->new( { filename => $file_c, quiet => 0 } ); 30 | is_deeply(sub_calls($pc), { 31 | 'main::sub7' => 1, 32 | 'DB::finish_profile' => 1, 33 | }, "$file_c sub calls"); 34 | }, 35 | }); 36 | 37 | sub sub_calls { 38 | my ($profile) = @_; 39 | my %sub_calls; 40 | for my $si (values %{ $profile->subname_subinfo_map }) { 41 | my $calls = $si->calls 42 | or next; 43 | $sub_calls{ $si->subname } = $calls; 44 | } 45 | print "sub_calls: { @{[ %sub_calls ]} }\n"; 46 | return \%sub_calls; 47 | } 48 | -------------------------------------------------------------------------------- /t/test51-enable.x: -------------------------------------------------------------------------------- 1 | # Profile data generated by Devel::NYTProf::Reader 2 | # More information at http://metacpan.org/release/Devel-NYTProf/ 3 | # Format: time,calls,time/call,code 4 | 0,0,0,# test using enable_profile() to write multiple profile files 5 | 0,0,0, 6 | 0,1,0,my $file_b = "nytprof-test51-b.out"; 7 | 0,1,0,my $file_c = "nytprof-test51-c.out"; 8 | 0,1,0,unlink $file_b, $file_c; 9 | 0,0,0, 10 | 0,1,0,sub sub1 { 1 } 11 | 0,0,0,sub sub2 { 1 } 12 | 0,0,0,sub sub3 { 1 } 13 | 0,0,0,sub sub4 { 1 } 14 | 0,0,0,sub sub5 { 1 } 15 | 0,0,0,sub sub6 { 1 } 16 | 0,0,0,sub sub7 { 1 } 17 | 0,0,0,sub sub8 { 1 } 18 | 0,0,0, 19 | 0,1,0,sub1(); # profiled 20 | 0,0,0, 21 | 0,0,0,DB::disable_profile(); # also tests that sub1() call timing has completed 22 | 0,0,0, 23 | 0,0,0,sub2(); # not profiled 24 | 0,0,0, 25 | 0,0,0,# switch to new file and (re)enable profiling 26 | 0,0,0,# the new file includes accumulated fid and subs-called data 27 | 0,0,0,DB::enable_profile($file_b); 28 | 0,0,0, 29 | 0,0,0,sub3(); # profiled 30 | 0,0,0, 31 | 0,0,0,DB::finish_profile(); 32 | 0,0,0,die "$file_b should exist" unless -s $file_b; 33 | 0,0,0, 34 | 0,0,0,sub4(); # not profiled 35 | 0,0,0, 36 | 0,0,0,# enable to new file 37 | 0,0,0,DB::enable_profile($file_c); 38 | 0,0,0, 39 | 0,0,0,sub5(); # profiled but file will be overwritten by enable_profile() below 40 | 0,0,0, 41 | 0,0,0,DB::finish_profile(); 42 | 0,0,0, 43 | 0,0,0,sub6(); # not profiled 44 | 0,0,0, 45 | 0,0,0,DB::enable_profile(); # enable to current file 46 | 0,0,0, 47 | 0,0,0,sub7(); # profiled 48 | 0,0,0, 49 | 0,0,0,DB::finish_profile(); 50 | 0,0,0, 51 | 0,0,0,# This can be removed once we have a better test harness 52 | 0,0,0,-f $_ or die "$_ should exist" for ($file_b, $file_c); 53 | 0,0,0, 54 | 0,0,0,# TODO should test for enable/disable within subs 55 | -------------------------------------------------------------------------------- /t/test60-subname.calls: -------------------------------------------------------------------------------- 1 | Devel::NYTProf::Test::example_xsub 7 2 | Devel::NYTProf::Test::example_xsub;main::will_die 1 3 | main::launch 1 4 | main::CORE:wait 1 5 | main::CORE:open 1 6 | -------------------------------------------------------------------------------- /t/test60-subname.p: -------------------------------------------------------------------------------- 1 | # test sub name resolution 2 | use Devel::NYTProf::Test qw(example_xsub); 3 | 4 | # call XS sub directly 5 | Devel::NYTProf::Test::example_xsub("foo"); 6 | 7 | # call XS sub imported into main 8 | # (should still be reported as a call to Devel::NYTProf::Test::example_xsub) 9 | example_xsub("foo"); 10 | 11 | # call XS sub as a method (ignore the extra arg) 12 | Devel::NYTProf::Test->example_xsub(); 13 | 14 | # call XS sub as a method via subclass (ignore the extra arg) 15 | @Subclass::ISA = qw(Devel::NYTProf::Test); 16 | Subclass->example_xsub(); 17 | 18 | my $subname = "Devel::NYTProf::Test::example_xsub"; 19 | &$subname("foo"); 20 | 21 | # return from xsub call via an exception 22 | # should correctly record the name of the xsub 23 | sub will_die { die "foo\n" } 24 | eval { example_xsub(0, \&will_die); 1; }; 25 | warn "\$@ was not the expected 'foo': $@" if $@ ne "foo\n"; 26 | 27 | # goto &$sub 28 | sub launch { goto &$subname } 29 | launch("foo"); 30 | 31 | # call builtin 32 | wait(); 33 | 34 | # call builtin that exits via an exception 35 | eval { open my $f, '<&', 'nonesuch' }; # $@ "Bad filehandle: nonesuch" 36 | -------------------------------------------------------------------------------- /t/test60-subname.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | # XXX needed because the call from example_xsub to will_die, 8 | # made via call_sv() doesn't get profiled on older perls 9 | plan skip_all => "needs perl >= 5.8.9 or >= 5.10.1" 10 | if $] < 5.008009 or $] eq "5.010000"; 11 | 12 | run_test_group; 13 | -------------------------------------------------------------------------------- /t/test61-submerge.calls: -------------------------------------------------------------------------------- 1 | main::__ANON__[(eval 0)[test61-submerge.p:8]:1] 3 2 | main::__ANON__[(eval 0)[test61-submerge.p:8]:1];main::foo 3 3 | main::__ANON__[(eval 0)[test61-submerge.p:8]:1];main::foo;main::CORE:print 3 4 | -------------------------------------------------------------------------------- /t/test61-submerge.p: -------------------------------------------------------------------------------- 1 | # test merging of sub info and sub callers 2 | # which is applied to, e.g., anon subs inside evals 3 | 4 | sub foo { print "foo @_\n" } 5 | 6 | my $code = qq{ sub { foo() } $Devel::NYTProf::StrEvalTestPad}; 7 | 8 | eval($code)->(); eval($code)->(); eval($code)->(); 9 | -------------------------------------------------------------------------------- /t/test61-submerge.rdt: -------------------------------------------------------------------------------- 1 | attribute application test61-submerge.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 4 [ 0 3 ] 18 | fid_block_time 1 6 [ 0 1 ] 19 | fid_block_time 1 8 [ 0 3 ] 20 | fid_block_time 2 1 [ 0 2 ] 21 | fid_fileinfo 1 [ test61-submerge.p 1 2 0 0 ] 22 | fid_fileinfo 1 sub main::BEGIN 0-0 23 | fid_fileinfo 1 sub main::CORE:print 0-0 24 | fid_fileinfo 1 sub main::RUNTIME 1-1 25 | fid_fileinfo 1 sub main::foo 4-4 26 | fid_fileinfo 1 call 4 main::CORE:print [ 3 0 0 0 0 0 0 main::foo ] 27 | fid_fileinfo 1 call 8 main::__ANON__[(eval 1)[test61-submerge.p:8]:1] [ 3 0 0 0 0 0 0 main::RUNTIME ] 28 | fid_fileinfo 1 eval 8 [ count 1 nested 0 merged 2 ] 29 | fid_fileinfo 2 [ (eval 1)[test61-submerge.p:8] 1 8 2 2 0 0 ] 30 | fid_fileinfo 2 sub main::__ANON__[(eval 1)[test61-submerge.p:8]:1] 1-1 31 | fid_fileinfo 2 call 1 main::foo [ 3 0 0 0 0 0 0 main::__ANON__[(eval 1)[test61-submerge.p:8]:1]|main::__ANON__[(eval 2)[test61-submerge.p:8]:1]|main::__ANON__[(eval 3)[test61-submerge.p:8]:1] ] 32 | fid_line_time 1 4 [ 0 3 ] 33 | fid_line_time 1 6 [ 0 1 ] 34 | fid_line_time 1 8 [ 0 3 ] 35 | fid_line_time 2 1 [ 0 6 ] 36 | fid_sub_time 1 4 [ 0 3 ] 37 | fid_sub_time 1 6 [ 0 1 ] 38 | fid_sub_time 1 8 [ 0 3 ] 39 | fid_sub_time 2 1 [ 0 2 ] 40 | profile_modes fid_block_time block 41 | profile_modes fid_line_time line 42 | profile_modes fid_sub_time sub 43 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 44 | sub_subinfo main::CORE:print [ 1:0-0 calls 3 times 0 0 0 0 ] 45 | sub_subinfo main::CORE:print called_by 1:4 [ 3 0 0 0 0 0 0 main::foo ] 46 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 47 | sub_subinfo main::__ANON__[(eval 1)[test61-submerge.p:8]:1] [ 2:1-1 calls 3 times 0 0 0 0 ] 48 | sub_subinfo main::__ANON__[(eval 1)[test61-submerge.p:8]:1] called_by 1:8 [ 3 0 0 0 0 0 0 main::RUNTIME ] 49 | sub_subinfo main::__ANON__[(eval 1)[test61-submerge.p:8]:1] merge_donor main::__ANON__[(eval 2)[test61-submerge.p:8]:1] 50 | sub_subinfo main::__ANON__[(eval 1)[test61-submerge.p:8]:1] merge_donor main::__ANON__[(eval 3)[test61-submerge.p:8]:1] 51 | sub_subinfo main::foo [ 1:4-4 calls 3 times 0 0 0 0 ] 52 | sub_subinfo main::foo called_by 2:1 [ 3 0 0 0 0 0 0 main::__ANON__[(eval 1)[test61-submerge.p:8]:1]|main::__ANON__[(eval 2)[test61-submerge.p:8]:1]|main::__ANON__[(eval 3)[test61-submerge.p:8]:1] ] 53 | -------------------------------------------------------------------------------- /t/test61-submerge.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | $ENV{NYTPROF_TEST_SKIP_EVAL_NORM} = 1; 8 | 9 | run_test_group; 10 | -------------------------------------------------------------------------------- /t/test62-subcaller1-a.calls: -------------------------------------------------------------------------------- 1 | Devel::NYTProf::Test::example_xsub 2 2 | main::sub1 1 3 | main::CORE:sort 2 4 | main::CORE:sort;Devel::NYTProf::Test::example_xsub 3 5 | main::CORE:sort;main::sub2 6 6 | main::CORE:subst 1 7 | main::CORE:substcont 3 8 | main::sub4 2 9 | -------------------------------------------------------------------------------- /t/test62-subcaller1-a.p: -------------------------------------------------------------------------------- 1 | # test determination of subroutine caller in unusual cases 2 | 3 | # test dying from an xsub 4 | require Devel::NYTProf::Test; 5 | eval { Devel::NYTProf::Test::example_xsub(0, "die") }; 6 | 7 | # test dying from an xsub where the surrounding eval is an 8 | # argument to a sub call. This used to coredump. 9 | sub sub1 { $_[0] } 10 | sub1 eval { Devel::NYTProf::Test::example_xsub(0, "die") }; 11 | 12 | # test sub calls (xs and perl) from within a sort block 13 | sub sub2 { $_[0] } 14 | # sort block on one line due to change to line numbering in perl 5.21 15 | my @a = sort { Devel::NYTProf::Test::example_xsub(); sub2($a) <=> sub2($b); } (1,3,2); 16 | 17 | # test sub call as a sort block 18 | sub sub3 { $_[0] } # XXX not recorded due to limitation of perl 19 | my @b = sort \&sub3, 3, 1, 2; 20 | 21 | # test sub call from a subst 22 | sub sub4 { $_[0] } 23 | my $a = "abcbd"; 24 | $a =~ s/b/sub4(uc($1))/ge; 25 | 26 | exit 0; 27 | -------------------------------------------------------------------------------- /t/test62-subcaller1-a.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | plan skip_all => "needs perl >= 5.8.9 or >= 5.10.1" 8 | if $] < 5.008009 or $] eq "5.010000"; 9 | 10 | plan skip_all => "needs perl < 5.33.3 (see t/test62-subcaller1-b.t)" # XXX 11 | if $] >= 5.033003; 12 | 13 | plan skip_all => "NYTPROF_AUTHOR_TESTING only" unless $ENV{NYTPROF_AUTHOR_TESTING}; 14 | 15 | run_test_group; 16 | -------------------------------------------------------------------------------- /t/test62-subcaller1-b.calls: -------------------------------------------------------------------------------- 1 | main::CORE:substcont 3 2 | main::sub4 2 3 | Exporter::BEGIN@3 1 4 | Exporter::BEGIN@3;strict::import 1 5 | Exporter::BEGIN@4 1 6 | Exporter::BEGIN@4;strict::unimport 1 7 | Devel::NYTProf::Test::example_xsub 2 8 | main::sub1 1 9 | main::CORE:sort 2 10 | main::CORE:sort;Devel::NYTProf::Test::example_xsub 3 11 | main::CORE:sort;main::sub2 6 12 | main::CORE:subst 1 13 | -------------------------------------------------------------------------------- /t/test62-subcaller1-b.p: -------------------------------------------------------------------------------- 1 | # test determination of subroutine caller in unusual cases 2 | 3 | # test dying from an xsub 4 | require Devel::NYTProf::Test; 5 | eval { Devel::NYTProf::Test::example_xsub(0, "die") }; 6 | 7 | # test dying from an xsub where the surrounding eval is an 8 | # argument to a sub call. This used to coredump. 9 | sub sub1 { $_[0] } 10 | sub1 eval { Devel::NYTProf::Test::example_xsub(0, "die") }; 11 | 12 | # test sub calls (xs and perl) from within a sort block 13 | sub sub2 { $_[0] } 14 | # sort block on one line due to change to line numbering in perl 5.21 15 | my @a = sort { Devel::NYTProf::Test::example_xsub(); sub2($a) <=> sub2($b); } (1,3,2); 16 | 17 | # test sub call as a sort block 18 | sub sub3 { $_[0] } # XXX not recorded due to limitation of perl 19 | my @b = sort \&sub3, 3, 1, 2; 20 | 21 | # test sub call from a subst 22 | sub sub4 { $_[0] } 23 | my $a = "abcbd"; 24 | $a =~ s/b/sub4(uc($1))/ge; 25 | 26 | exit 0; 27 | -------------------------------------------------------------------------------- /t/test62-subcaller1-b.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | plan skip_all => "needs perl >= 5.33.3 (see t/test62-subcaller1-a)" 8 | if $] < 5.033003; 9 | 10 | run_test_group; 11 | -------------------------------------------------------------------------------- /t/test62-tie-a.calls: -------------------------------------------------------------------------------- 1 | MyTie::TIESCALAR 1 2 | MyTie::STORE 1 3 | MyTie::FETCH 1 4 | -------------------------------------------------------------------------------- /t/test62-tie-a.p: -------------------------------------------------------------------------------- 1 | # test determination of subroutine caller in tie calls 2 | 3 | { 4 | # calls to TIESCALAR aren't seen by perl < 5.8.9 and 5.10.1 5 | sub MyTie::TIESCALAR { bless {}, shift; } 6 | sub MyTie::FETCH { } 7 | sub MyTie::STORE { } 8 | } 9 | 10 | tie my $tied, 'MyTie', 42; # TIESCALAR 11 | $tied = 1; # STORE 12 | if ($tied) { 1 } # FETCH 13 | 14 | exit 0; 15 | -------------------------------------------------------------------------------- /t/test62-tie-a.rdt: -------------------------------------------------------------------------------- 1 | attribute application test62-tie-a.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 5 [ 0 2 ] 18 | fid_block_time 1 6 [ 0 1 ] 19 | fid_block_time 1 7 [ 0 1 ] 20 | fid_block_time 1 10 [ 0 1 ] 21 | fid_block_time 1 11 [ 0 1 ] 22 | fid_block_time 1 12 [ 0 1 ] 23 | fid_block_time 1 14 [ 0 1 ] 24 | fid_fileinfo 1 [ test62-tie-a.p 1 2 0 0 ] 25 | fid_fileinfo 1 sub MyTie::FETCH 6-6 26 | fid_fileinfo 1 sub MyTie::STORE 7-7 27 | fid_fileinfo 1 sub MyTie::TIESCALAR 5-5 28 | fid_fileinfo 1 sub main::BEGIN 0-0 29 | fid_fileinfo 1 sub main::RUNTIME 1-1 30 | fid_fileinfo 1 call 10 MyTie::TIESCALAR [ 1 0 0 0 0 0 0 main::RUNTIME ] 31 | fid_fileinfo 1 call 11 MyTie::STORE [ 1 0 0 0 0 0 0 main::RUNTIME ] 32 | fid_fileinfo 1 call 12 MyTie::FETCH [ 1 0 0 0 0 0 0 main::RUNTIME ] 33 | fid_line_time 1 5 [ 0 2 ] 34 | fid_line_time 1 6 [ 0 1 ] 35 | fid_line_time 1 7 [ 0 1 ] 36 | fid_line_time 1 10 [ 0 1 ] 37 | fid_line_time 1 11 [ 0 1 ] 38 | fid_line_time 1 12 [ 0 1 ] 39 | fid_line_time 1 14 [ 0 1 ] 40 | fid_sub_time 1 5 [ 0 2 ] 41 | fid_sub_time 1 6 [ 0 1 ] 42 | fid_sub_time 1 7 [ 0 1 ] 43 | fid_sub_time 1 10 [ 0 1 ] 44 | fid_sub_time 1 11 [ 0 1 ] 45 | fid_sub_time 1 12 [ 0 1 ] 46 | fid_sub_time 1 14 [ 0 1 ] 47 | profile_modes fid_block_time block 48 | profile_modes fid_line_time line 49 | profile_modes fid_sub_time sub 50 | sub_subinfo MyTie::FETCH [ 1:6-6 calls 1 times 0 0 0 0 ] 51 | sub_subinfo MyTie::FETCH called_by 1:12 [ 1 0 0 0 0 0 0 main::RUNTIME ] 52 | sub_subinfo MyTie::STORE [ 1:7-7 calls 1 times 0 0 0 0 ] 53 | sub_subinfo MyTie::STORE called_by 1:11 [ 1 0 0 0 0 0 0 main::RUNTIME ] 54 | sub_subinfo MyTie::TIESCALAR [ 1:5-5 calls 1 times 0 0 0 0 ] 55 | sub_subinfo MyTie::TIESCALAR called_by 1:10 [ 1 0 0 0 0 0 0 main::RUNTIME ] 56 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 57 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 58 | -------------------------------------------------------------------------------- /t/test62-tie-a.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | plan skip_all => "needs perl >= 5.8.9 or >= 5.10.1" 8 | if $] < 5.008009 or $] eq "5.010000"; 9 | 10 | plan skip_all => "needs perl < 5.21.1 (see t/test62-tie-b.t)" # XXX 11 | if $] >= 5.021001; 12 | 13 | run_test_group; 14 | -------------------------------------------------------------------------------- /t/test62-tie-b.calls: -------------------------------------------------------------------------------- 1 | MyTie::TIESCALAR 1 2 | MyTie::STORE 1 3 | MyTie::FETCH 1 4 | -------------------------------------------------------------------------------- /t/test62-tie-b.p: -------------------------------------------------------------------------------- 1 | # test determination of subroutine caller in tie calls 2 | 3 | { 4 | # calls to TIESCALAR aren't seen by perl < 5.8.9 and 5.10.1 5 | sub MyTie::TIESCALAR { bless {}, shift; } 6 | sub MyTie::FETCH { } 7 | sub MyTie::STORE { } 8 | } 9 | 10 | tie my $tied, 'MyTie', 42; # TIESCALAR 11 | $tied = 1; # STORE 12 | if ($tied) { 1 } # FETCH 13 | 14 | exit 0; 15 | -------------------------------------------------------------------------------- /t/test62-tie-b.rdt: -------------------------------------------------------------------------------- 1 | attribute application test62-tie-b.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 5 [ 0 1 ] 18 | fid_block_time 1 6 [ 0 1 ] 19 | fid_block_time 1 7 [ 0 1 ] 20 | fid_block_time 1 10 [ 0 2 ] 21 | fid_block_time 1 11 [ 0 1 ] 22 | fid_block_time 1 12 [ 0 1 ] 23 | fid_block_time 1 14 [ 0 1 ] 24 | fid_fileinfo 1 [ test62-tie-b.p 1 2 0 0 ] 25 | fid_fileinfo 1 sub MyTie::FETCH 6-6 26 | fid_fileinfo 1 sub MyTie::STORE 7-7 27 | fid_fileinfo 1 sub MyTie::TIESCALAR 5-5 28 | fid_fileinfo 1 sub main::BEGIN 0-0 29 | fid_fileinfo 1 sub main::RUNTIME 1-1 30 | fid_fileinfo 1 call 10 MyTie::TIESCALAR [ 1 0 0 0 0 0 0 main::RUNTIME ] 31 | fid_fileinfo 1 call 11 MyTie::STORE [ 1 0 0 0 0 0 0 main::RUNTIME ] 32 | fid_fileinfo 1 call 12 MyTie::FETCH [ 1 0 0 0 0 0 0 main::RUNTIME ] 33 | fid_line_time 1 5 [ 0 1 ] 34 | fid_line_time 1 6 [ 0 1 ] 35 | fid_line_time 1 7 [ 0 1 ] 36 | fid_line_time 1 10 [ 0 2 ] 37 | fid_line_time 1 11 [ 0 1 ] 38 | fid_line_time 1 12 [ 0 1 ] 39 | fid_line_time 1 14 [ 0 1 ] 40 | fid_sub_time 1 5 [ 0 1 ] 41 | fid_sub_time 1 6 [ 0 1 ] 42 | fid_sub_time 1 7 [ 0 1 ] 43 | fid_sub_time 1 10 [ 0 2 ] 44 | fid_sub_time 1 11 [ 0 1 ] 45 | fid_sub_time 1 12 [ 0 1 ] 46 | fid_sub_time 1 14 [ 0 1 ] 47 | profile_modes fid_block_time block 48 | profile_modes fid_line_time line 49 | profile_modes fid_sub_time sub 50 | sub_subinfo MyTie::FETCH [ 1:6-6 calls 1 times 0 0 0 0 ] 51 | sub_subinfo MyTie::FETCH called_by 1:12 [ 1 0 0 0 0 0 0 main::RUNTIME ] 52 | sub_subinfo MyTie::STORE [ 1:7-7 calls 1 times 0 0 0 0 ] 53 | sub_subinfo MyTie::STORE called_by 1:11 [ 1 0 0 0 0 0 0 main::RUNTIME ] 54 | sub_subinfo MyTie::TIESCALAR [ 1:5-5 calls 1 times 0 0 0 0 ] 55 | sub_subinfo MyTie::TIESCALAR called_by 1:10 [ 1 0 0 0 0 0 0 main::RUNTIME ] 56 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 57 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 58 | -------------------------------------------------------------------------------- /t/test62-tie-b.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | plan skip_all => "needs perl >= 5.21.1 (see t/test62-tie-a)" 8 | if $] < 5.021001; 9 | 10 | run_test_group; 11 | -------------------------------------------------------------------------------- /t/test70-subexcl.calls: -------------------------------------------------------------------------------- 1 | main::D 1 2 | main::D;main::C 2 3 | main::D;main::C;main::B 2 4 | main::D;main::C;main::B;main::CORE:sselect 2 5 | main::D;main::C;main::B;main::A 2 6 | main::D;main::C;main::B;main::A;main::CORE:sselect 2 7 | -------------------------------------------------------------------------------- /t/test70-subexcl.p: -------------------------------------------------------------------------------- 1 | # This test isn't very useful until we can test subroutine timings 2 | # perhaps by adding an option to nytprofcsv to include them 3 | # and adjusting test.pl to test for them (including the ~N fudge factor). 4 | # Meanwhile the test is useful for sanity checking the subroutine timing 5 | # code using a command like 6 | # make && NYTPROF_TEST=trace=3 perl -Mblib test.pl -leave=1 -use_db_sub=0 t/test70-subexcl.* 7 | 8 | my $T = $ENV{NYTPROF_TEST_PAUSE_TIME} || 0.2; 9 | 10 | sub A { # inclusive ~= $T, exclusive ~= $T 11 | select undef, undef, undef, $T; 12 | } 13 | 14 | sub B { # inclusive ~= $T*2, exclusive ~= $T 15 | A(); 16 | select undef, undef, undef, $T; 17 | } 18 | 19 | sub C { # inclusive ~= $T*2, exclusive ~= 0.0 20 | B(); 21 | } 22 | 23 | sub D { # inclusive ~= $T*4, exclusive ~= 0.0 24 | C(); 25 | C(); # cumulative_subr_secs non-zero on sub entry 26 | } 27 | 28 | D(); 29 | -------------------------------------------------------------------------------- /t/test70-subexcl.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test80-recurs.calls: -------------------------------------------------------------------------------- 1 | main::recurs 1 2 | main::recurs;main::CORE:sselect 1 3 | main::recurs;main::recurs 1 4 | main::recurs;main::recurs;main::CORE:sselect 1 5 | main::recurs;main::recurs;main::recurs 1 6 | main::recurs;main::recurs;main::recurs;main::CORE:sselect 1 7 | -------------------------------------------------------------------------------- /t/test80-recurs.p: -------------------------------------------------------------------------------- 1 | sub recurs { 2 | my $depth = shift; 3 | select(undef, undef, undef, 0.3); 4 | recurs($depth-1) if $depth > 1; 5 | } 6 | 7 | recurs(3); # recurs gets called twice 8 | 9 | -------------------------------------------------------------------------------- /t/test80-recurs.rdt: -------------------------------------------------------------------------------- 1 | attribute application test80-recurs.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute complete 1 5 | attribute nv_size 0 6 | attribute perl_version 0 7 | attribute profiler_active 0 8 | attribute profiler_duration 0 9 | attribute profiler_end_time 0 10 | attribute profiler_start_time 0 11 | attribute ticks_per_sec 0 12 | attribute total_stmts_discounted 0 13 | attribute total_stmts_duration 0 14 | attribute total_stmts_measured 0 15 | attribute total_sub_calls 0 16 | attribute xs_version 0 17 | fid_block_time 1 2 [ 0 9 ] 18 | fid_block_time 1 7 [ 0 1 ] 19 | fid_fileinfo 1 [ test80-recurs.p 1 2 0 0 ] 20 | fid_fileinfo 1 sub main::BEGIN 0-0 21 | fid_fileinfo 1 sub main::CORE:sselect 0-0 22 | fid_fileinfo 1 sub main::RUNTIME 1-1 23 | fid_fileinfo 1 sub main::recurs 1-5 24 | fid_fileinfo 1 call 3 main::CORE:sselect [ 3 0 0 0 0 0 0 main::recurs ] 25 | fid_fileinfo 1 call 4 main::recurs [ 2 0 0 0 0 0 2 main::recurs ] 26 | fid_fileinfo 1 call 7 main::recurs [ 1 0 0 0 0 0 0 main::RUNTIME ] 27 | fid_line_time 1 2 [ 0 3 ] 28 | fid_line_time 1 3 [ 0 3 ] 29 | fid_line_time 1 4 [ 0 3 ] 30 | fid_line_time 1 7 [ 0 1 ] 31 | fid_sub_time 1 2 [ 0 9 ] 32 | fid_sub_time 1 7 [ 0 1 ] 33 | profile_modes fid_block_time block 34 | profile_modes fid_line_time line 35 | profile_modes fid_sub_time sub 36 | sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ] 37 | sub_subinfo main::CORE:sselect [ 1:0-0 calls 3 times 0 0 0 0 ] 38 | sub_subinfo main::CORE:sselect called_by 1:3 [ 3 0 0 0 0 0 0 main::recurs ] 39 | sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ] 40 | sub_subinfo main::recurs [ 1:1-5 calls 3 times 0 0 2 0 ] 41 | sub_subinfo main::recurs called_by 1:4 [ 2 0 0 0 0 0 2 main::recurs ] 42 | sub_subinfo main::recurs called_by 1:7 [ 1 0 0 0 0 0 0 main::RUNTIME ] 43 | -------------------------------------------------------------------------------- /t/test80-recurs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | run_test_group; 8 | -------------------------------------------------------------------------------- /t/test81-swash.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests implicit calling of utf8::SWASHNEW from unicode regex. 4 | # 5 | # Actually a stress test of all sorts of nasty cases including opcodes calling 6 | # back to perl and stack switching (PUSHSTACKi(PERLSI_MAGIC)). 7 | 8 | use Test::More; 9 | 10 | use lib qw(t/lib); 11 | use NYTProfTest; 12 | 13 | use Devel::NYTProf::Run qw(profile_this); 14 | 15 | my $src_code = join("", ); 16 | 17 | run_test_group( { 18 | extra_options => { 19 | start => 'begin', 20 | compress => 1, 21 | }, 22 | extra_test_count => 2, 23 | extra_test_code => sub { 24 | my ($profile, $env) = @_; 25 | 26 | $profile = profile_this( 27 | src_code => $src_code, 28 | out_file => $env->{file}, 29 | skip_sitecustomize => 1, 30 | ); 31 | isa_ok $profile, 'Devel::NYTProf::Data'; 32 | # check if data truncated due to assertion failure 33 | ok $profile->{attribute}{complete}; 34 | }, 35 | }); 36 | 37 | # crashes with perl 5.11.1+ 38 | __DATA__ 39 | $_ = "N\x{100}"; 40 | chop $_; 41 | s/ 42 | (?: [A-Z] | [\d] )+ 43 | (?= [\s] ) 44 | //x; 45 | -------------------------------------------------------------------------------- /t/test82-version.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests interaction with UNIVERSAL::VERSION (RT#54600) 4 | 5 | use Test::More; 6 | 7 | use lib qw(t/lib); 8 | use NYTProfTest; 9 | 10 | use Devel::NYTProf::Run qw(profile_this); 11 | 12 | my $src_code = join("", ); 13 | 14 | run_test_group( { 15 | extra_options => { 16 | start => 'begin', 17 | compress => 1, 18 | leave => 0, 19 | stmts => 0, 20 | slowops => 0, 21 | }, 22 | extra_test_count => 2, 23 | extra_test_code => sub { 24 | my ($profile, $env) = @_; 25 | 26 | $profile = profile_this( 27 | src_code => $src_code, 28 | out_file => $env->{file}, 29 | skip_sitecustomize => 1, 30 | ); 31 | isa_ok $profile, 'Devel::NYTProf::Data'; 32 | # check if data was truncated 33 | ok $profile->{attribute}{complete}; 34 | }, 35 | }); 36 | 37 | __DATA__ 38 | #!perl -w 39 | { 40 | package X; 41 | 42 | sub warner { 43 | print "# Hello world\n" 44 | } 45 | 46 | sub DESTROY { 47 | goto \&warner; 48 | } 49 | } 50 | 51 | my $a = bless [], 'X'; 52 | 53 | undef $a; 54 | -------------------------------------------------------------------------------- /t/test90-strsubref.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | # Tests dieing on Can't use string ... as a subroutine ref while "strict refs" in use 4 | # that used to core dump (RT#86638) 5 | # https://rt.cpan.org/Ticket/Display.html?id=86638 6 | 7 | use Test::More; 8 | 9 | use lib qw(t/lib); 10 | use NYTProfTest; 11 | 12 | use Devel::NYTProf::Run qw(profile_this); 13 | 14 | my $src_code = join("", ); 15 | 16 | run_test_group( { 17 | extra_options => { 18 | start => 'begin', 19 | compress => 1, 20 | calls => 0, 21 | savesrc => 0, 22 | stmts => 0, 23 | slowops => 0, 24 | }, 25 | extra_test_count => 2, 26 | extra_test_code => sub { 27 | my ($profile, $env) = @_; 28 | 29 | $profile = profile_this( 30 | src_code => $src_code, 31 | out_file => $env->{file}, 32 | skip_sitecustomize => 1, 33 | ); 34 | isa_ok $profile, 'Devel::NYTProf::Data'; 35 | # check if data was truncated 36 | ok $profile->{attribute}{complete}; 37 | }, 38 | }); 39 | 40 | __DATA__ 41 | #!perl 42 | use strict; 43 | # Can't use string ("") as a subroutine ref while "strict refs" in use at - line 4. 44 | eval { $x::z->() }; 45 | die $@ if $@ !~ /^Can't use .* as a subroutine ref/; 46 | -------------------------------------------------------------------------------- /t/zzz.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More qw(no_plan); 4 | 5 | pass(); 6 | 7 | # we note the time in the test log here (the first test) and in t/zzz.t 8 | # so we can judge how fast the set of tests ran and this the rough speed of the system 9 | diag("Tests ended at ". localtime(time)); 10 | -------------------------------------------------------------------------------- /typemap: -------------------------------------------------------------------------------- 1 | const char * T_PV 2 | NYTP_file T_NYTPROF_FILE 3 | 4 | INPUT 5 | T_NYTPROF_FILE 6 | if (sv_isa($arg, \"Devel::NYTProf::FileHandle\")) 7 | $var = (NYTP_file)SvPVX(SvRV($arg)); 8 | else 9 | Perl_croak(aTHX_ \"%s: %s is not of type Devel::NYTProf::FileHandle\", 10 | ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, 11 | \"$var\") 12 | -------------------------------------------------------------------------------- /xt/61-cputime.t: -------------------------------------------------------------------------------- 1 | # Tests CORE::GLOBAL::foo plus assorted data model methods 2 | 3 | use strict; 4 | use Test::More; 5 | 6 | use lib qw(t/lib); 7 | use NYTProfTest; 8 | use Data::Dumper; 9 | 10 | use Devel::NYTProf::Run qw(profile_this); 11 | 12 | my $src_code = join("", ); 13 | 14 | run_test_group( { 15 | extra_options => { 16 | # set options for this test: 17 | usecputime => 1, 18 | # restrict irrelevant options: 19 | compress => 1, slowops => 0, savesrc => 0, leave => 0, stmts => 0, 20 | }, 21 | extra_test_count => 6, 22 | extra_test_code => sub { 23 | my ($profile, $env) = @_; 24 | my $trace = ($^O eq 'freebsd'); # XXX temp 25 | 26 | $profile = profile_this( 27 | src_code => $src_code, 28 | out_file => $env->{file}, 29 | #htmlopen => 1, 30 | verbose => $trace, 31 | skip_sitecustomize => 1, 32 | ); 33 | isa_ok $profile, 'Devel::NYTProf::Data'; 34 | warn "ticks_per_sec ".$profile->attributes->{ticks_per_sec}."\n" 35 | if $trace; 36 | 37 | my $subs = $profile->subname_subinfo_map; 38 | my $sub = $subs->{'main::foo'}; 39 | ok $sub; 40 | is $sub->calls, 1, 'main::foo should be called 1 time'; 41 | cmp_ok $sub->incl_time, '>=', 0.4 * 0.99, 'cputime of foo() should be at least 0.4'; 42 | cmp_ok $sub->incl_time, '<', 1.1, 'cputime of foo() should be not much more than 0.4'; 43 | is $sub->incl_time, $sub->excl_time, 'incl_time and excl_time should be the same'; 44 | }, 45 | }); 46 | 47 | __DATA__ 48 | #!perl 49 | 50 | BEGIN { eval { require Time::HiRes } and Time::HiRes->import('time') } 51 | 52 | alarm(20); # watchdog timer 53 | 54 | my $trace = 0; 55 | my $cpu1; 56 | my $cpu2; 57 | 58 | sub foo { 59 | my $cpuspend = shift; 60 | 61 | # sleep to separate cputime from realtime 62 | # (not very effective in cpu-starved VMs) 63 | sleep 1; 64 | 65 | my $loops = 0; 66 | my $prev; 67 | while (++$loops) { 68 | my @times = times; 69 | my $crnt = $times[0] + $times[1] - $cpu1; 70 | warn sprintf "tick %.4f\t%f\n", $crnt, time() 71 | if $trace >= 2 && $prev && $crnt != $prev; 72 | $prev = $crnt; 73 | 74 | last if $crnt >= $cpuspend; 75 | } 76 | warn "cputime loop count $loops\n" if $trace >= 2; 77 | } 78 | 79 | # record start time 80 | my $start = time() + 1; 81 | 82 | # sync up... 83 | 84 | # spin till wall clock ticks 85 | 1 while time() <= $start; 86 | 87 | # spin till cpu clock ticks (typically 0.1 sec max) 88 | my @times = times; 89 | $cpu1 = $times[0] + $times[1]; 90 | while (1) { 91 | @times = times; 92 | $cpu2 = $times[0] + $times[1]; 93 | last if $cpu2 != $cpu1; 94 | } 95 | 96 | warn sprintf "step %f\t%f\n", $cpu2-$cpu1, time() if $trace; 97 | $cpu1 = $cpu2; # set cpu1 to new current cpu time 98 | 99 | # consume this much cpu time inside foo() 100 | foo(0.4); 101 | 102 | # report realtime to help identify is cputime is really measuring realtime 103 | print "realtime used ".(time()-$start)."\n" if $trace; 104 | -------------------------------------------------------------------------------- /xt/68-hashline.t: -------------------------------------------------------------------------------- 1 | # Tests CORE::GLOBAL::foo plus assorted data model methods 2 | 3 | use strict; 4 | use Test::More; 5 | 6 | use lib qw(t/lib); 7 | use NYTProfTest; 8 | 9 | use Devel::NYTProf::Run qw(profile_this); 10 | 11 | plan skip_all => "Currently a developer-only test" unless -d '../.git'; 12 | 13 | warn "This test script needs more work\n"; 14 | 15 | my $src_code = join("", ); 16 | 17 | run_test_group( { 18 | extra_options => { 19 | start => 'begin', compress => 1, stmts => 1, slowops => 0, 20 | }, 21 | extra_test_count => 2, 22 | extra_test_code => sub { 23 | my ($profile, $env) = @_; 24 | 25 | $profile = profile_this( 26 | src_code => $src_code, 27 | out_file => $env->{file}, 28 | skip_sitecustomize => 1, 29 | htmlopen => $ENV{NYTPROF_TEST_HTMLOPEN}, 30 | ); 31 | isa_ok $profile, 'Devel::NYTProf::Data'; 32 | 33 | my $subs = $profile->subname_subinfo_map; 34 | 35 | ok 1; 36 | }, 37 | }); 38 | 39 | __DATA__ 40 | sub a { 0 } 41 | #line 101 "hash-line-first" 42 | sub b { 1 } 43 | #line 202 "hash-line-second" 44 | sub c { 2 } 45 | eval qq{#line 303 "hash-line-eval" 46 | sub d { 3 } 47 | 1} or die; 48 | a(); b(); c(); d(); 49 | print "# File: $_\n" for sort grep { m/_ $DB::sub{$_}\n" for sort keys %DB::sub; 51 | -------------------------------------------------------------------------------- /xt/71-moose.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | eval "use Moose 2.0; 1" 8 | or plan skip_all => "Moose 2.0 required"; 9 | 10 | print "Moose $Moose::VERSION $INC{'Moose.pm'}\n"; 11 | 12 | plan skip_all => "Test is incomplete (has no results defined yet)";# unless -d '.svn'; 13 | 14 | use Devel::NYTProf::Run qw(profile_this); 15 | 16 | my $src_code = join("", ); 17 | 18 | run_test_group( { 19 | extra_options => { 20 | start => 'begin', compress => 1, stmts => 0, slowops => 0, 21 | }, 22 | extra_test_count => 2, 23 | extra_test_code => sub { 24 | my ($profile, $env) = @_; 25 | 26 | $profile = profile_this( 27 | src_code => $src_code, 28 | out_file => $env->{file}, 29 | skip_sitecustomize => 1, 30 | htmlopen => $ENV{NYTPROF_TEST_HTMLOPEN}, 31 | ); 32 | isa_ok $profile, 'Devel::NYTProf::Data'; 33 | 34 | my $subs = $profile->subname_subinfo_map; 35 | 36 | ok 1; 37 | }, 38 | }); 39 | 40 | __DATA__ 41 | #!perl 42 | package P; 43 | use Moose; 44 | has attrib_std => ( is => 'rw', default => 42 ); 45 | has attrib_lazy => ( is => 'rw', lazy => 1, default => sub { 43 } ); 46 | END { 47 | my $p = P->new; 48 | print $p->attrib_std."\n"; 49 | print $p->attrib_lazy."\n"; 50 | } 51 | -------------------------------------------------------------------------------- /xt/72-autodie.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | 4 | use lib qw(t/lib); 5 | use NYTProfTest; 6 | 7 | eval "use autodie; 1" 8 | or plan skip_all => "autodie required"; 9 | 10 | print "autodie $autodie::VERSION $INC{'autodie.pm'}\n"; 11 | 12 | plan skip_all => "Currently a developer-only test" unless -d '../.git'; 13 | 14 | warn "This test script needs more work\n"; 15 | 16 | use Devel::NYTProf::Run qw(profile_this); 17 | 18 | my $src_code = join("", ); 19 | 20 | run_test_group( { 21 | extra_options => { 22 | start => 'begin', compress => 1, stmts => 0, slowops => 0, 23 | }, 24 | extra_test_count => 2, 25 | extra_test_code => sub { 26 | my ($profile, $env) = @_; 27 | 28 | $profile = profile_this( 29 | src_code => $src_code, 30 | out_file => $env->{file}, 31 | skip_sitecustomize => 1, 32 | htmlopen => $ENV{NYTPROF_TEST_HTMLOPEN}, 33 | ); 34 | isa_ok $profile, 'Devel::NYTProf::Data'; 35 | 36 | my $subs = $profile->subname_subinfo_map; 37 | 38 | ok 1; 39 | }, 40 | }); 41 | 42 | __DATA__ 43 | #!perl 44 | package P; 45 | use autodie; 46 | eval { rmdir "nonsuch file name" }; 47 | -------------------------------------------------------------------------------- /xt/91-pod_coverage.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | eval "use Test::Pod::Coverage 1.04"; 9 | plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; 10 | plan skip_all => "Currently a developer-only test" unless -d '.git'; 11 | 12 | plan skip_all => "needs work"; 13 | 14 | all_pod_coverage_ok({ also_private => [ qr/removeChildAt/ ] }); 15 | -------------------------------------------------------------------------------- /xt/92-file_port.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | eval "require Test::Portability::Files;"; 9 | plan skip_all => "Test::Portability::Files required for testing filename portability. ${ $@=~s/\.pm .*/.pm/, \$@ }" 10 | if $@; 11 | 12 | plan skip_all => "Set NYTPROF_TEST_PORTABILITY_FILES env var to enable test" 13 | unless $ENV{'NYTPROF_TEST_PORTABILITY_FILES'}; 14 | 15 | Test::Portability::Files->import(); # calls plan() 16 | #options(use_file_find => 1); # test all files not just those in MANIFEST (lots of .svn/* errors) 17 | #options(all_tests => 1); # to be hyper-strict (e.g., lots of DOS 8.3 length errors) 18 | run_tests(); 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /xt/test23-strevalxs.p: -------------------------------------------------------------------------------- 1 | # test string eval made from embedded environment 2 | use Devel::NYTProf::Test qw(example_xsub_eval); 3 | 4 | example_xsub_eval(); # calls eval_pv() perlapi 5 | -------------------------------------------------------------------------------- /xt/test23-strevalxs.rdt: -------------------------------------------------------------------------------- 1 | attribute application test23-strevalxs.p 2 | attribute basetime 0 3 | attribute clock_id 0 4 | attribute nv_size 0 5 | attribute perl_version 0 6 | attribute profiler_duration 0 7 | attribute profiler_end_time 0 8 | attribute profiler_start_time 0 9 | attribute ticks_per_sec 0 10 | attribute total_stmts_discounted 0 11 | attribute total_stmts_duration 0 12 | attribute total_stmts_measured 0 13 | attribute total_sub_calls 0 14 | attribute xs_version 0 15 | fid_block_time 1 4 0 0 16 | fid_block_time 1 4 1 1 17 | fid_block_time 1 4 2 1 [ 0 1 ] 18 | fid_fileinfo 1 [ test23-strevalxs.p 1 2 0 0 ] 19 | fid_fileinfo 1 sub main::BEGIN 2-2 20 | fid_fileinfo 1 call 4 Devel::NYTProf::Test::example_xsub_eval [ 1 0 0 0 0 0 0 ] 21 | fid_fileinfo 1 eval 4 [ 1 0 ] 22 | fid_fileinfo 2 [ (eval 0)[test23-strevalxs.p:4] 1 4 2 2 0 0 ] 23 | fid_fileinfo 2 call 1 Devel::NYTProf::Test::example_xsub [ 1 0 0 0 0 0 0 ] 24 | fid_fileinfo 3 [ Devel/NYTProf/Test.pm 3 4 0 0 ] 25 | fid_fileinfo 3 sub Devel::NYTProf::Test::example_sub 13-13 26 | fid_fileinfo 3 sub Devel::NYTProf::Test::example_xsub 0-0 27 | fid_fileinfo 3 sub Devel::NYTProf::Test::example_xsub_eval 0-0 28 | fid_line_time 1 4 0 0 29 | fid_line_time 1 4 1 1 30 | fid_line_time 1 4 2 1 [ 0 1 ] 31 | fid_sub_time 1 4 0 0 32 | fid_sub_time 1 4 1 1 33 | fid_sub_time 1 4 2 1 [ 0 1 ] 34 | profile_modes fid_block_time block 35 | profile_modes fid_line_time line 36 | profile_modes fid_sub_time sub 37 | sub_subinfo Devel::NYTProf::Test::example_sub [ 3 13 13 0 0 0 0 0 ] 38 | sub_subinfo Devel::NYTProf::Test::example_xsub [ 3 0 0 1 0 0 0 0 ] 39 | sub_subinfo Devel::NYTProf::Test::example_xsub called_by 2 1 [ 1 0 0 0 0 0 0 ] 40 | sub_subinfo Devel::NYTProf::Test::example_xsub_eval [ 3 0 0 1 0 0 0 0 ] 41 | sub_subinfo Devel::NYTProf::Test::example_xsub_eval called_by 1 4 [ 1 0 0 0 0 0 0 ] 42 | sub_subinfo main::BEGIN [ 1 2 2 0 0 0 0 0 ] 43 | -------------------------------------------------------------------------------- /xt/test23-strevalxs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | use lib qw(t/lib); 4 | use NYTProfTest; 5 | 6 | run_test_group; 7 | -------------------------------------------------------------------------------- /xt/test45-overload.p: -------------------------------------------------------------------------------- 1 | # test to see that 2 | 3 | # example from the overload docs (with slight changes) 4 | { 5 | package two_face; # Scalars with separate string and numeric values. 6 | 7 | use overload 8 | '""' => \&str, # ref to named sub 9 | '0+' => sub {shift->[0]}, # ref to anon sub 10 | '&{}' => "code", # name of method 11 | fallback => 1; 12 | 13 | sub new { 14 | my $p = shift; 15 | bless [@_], $p 16 | } 17 | sub str { 18 | shift->[0] 19 | } 20 | sub code { 21 | sub { 1 } 22 | } 23 | 24 | } 25 | 26 | my $seven = new two_face ("vii", 7); 27 | printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1; 28 | print "seven contains ‘i’\n" if $seven =~ /i/; 29 | $seven->(); 30 | -------------------------------------------------------------------------------- /xt/test71-while.p: -------------------------------------------------------------------------------- 1 | $a = 2; 2 | 3 | sub A { } 4 | sub B { } 5 | sub C { --$a } 6 | 7 | $a = 2; 8 | while ( C() ) { 9 | A(); 10 | } 11 | 12 | $a = 2; 13 | while ( C() ) { 14 | A(); 15 | } 16 | continue { 17 | B(); 18 | } 19 | -------------------------------------------------------------------------------- /xt/test82-stress.t: -------------------------------------------------------------------------------- 1 | # Stress tests 2 | 3 | use strict; 4 | use Test::More; 5 | 6 | use lib qw(t/lib); 7 | use NYTProfTest; 8 | use Data::Dumper; 9 | 10 | use Devel::NYTProf::Run qw(profile_this); 11 | 12 | my $src_code = join("", ); 13 | 14 | run_test_group( { 15 | extra_options => { 16 | compress => 1, 17 | savesrc => 1, 18 | }, 19 | extra_test_code => sub { 20 | my ($profile, $env) = @_; 21 | 22 | $profile = profile_this( 23 | src_code => $src_code, 24 | out_file => $env->{file}, 25 | ); 26 | isa_ok $profile, 'Devel::NYTProf::Data'; 27 | # check if data truncated e.g. due to assertion failure 28 | ok $profile->{attribute}{complete}; 29 | 30 | ok my $subs = $profile->subs_defined_in_file(1); 31 | ok $subs->{'main::pass'}->calls; 32 | 33 | }, 34 | extra_test_count => 4, 35 | }); 36 | 37 | __DATA__ 38 | 39 | # test for old perl bug 20010515.004 that NYTProf tickled into life 40 | # http://markmail.org/message/3q6q2on3gl6fzdhv 41 | # http://markmail.org/message/b7qnerilkusauydf 42 | # based on test in perl's t/run/fresh_perl.t 43 | my @h = 1 .. 10; 44 | sub bad { 45 | undef @h; 46 | open BUF, '>', \my $stdout_buf or die "Can't open STDOUT: $!"; 47 | # is the bug is tickled this will print something like 48 | # HASH(0x82acc0)ARRAY(0x821b60)ARRAY(0x812f10)HASH(0x8133f0)HASH(0x8133f0)ARRAY(0x821b60)00 49 | print BUF for @_; # this line is very sensitive to changes 50 | die "\@_ affected by NYTProf" if $stdout_buf; 51 | close BUF; 52 | } 53 | bad(@h); 54 | 55 | sub pass { }; pass(); # flag successful completion 56 | -------------------------------------------------------------------------------- /xt/test90-stress.p: -------------------------------------------------------------------------------- 1 | # Assorted stress tests 2 | # We're happy if we run this without dieing... 3 | 4 | my $is_developer = (-d '.svn'); 5 | 6 | check_readonly() if $is_developer; 7 | 8 | sub check_readonly { 9 | unless (eval { require Readonly }) { 10 | warn "readonly test skipped - Readonly module not installed\n"; 11 | return; 12 | } 13 | # Check for # "Invalid tie at .../Readonly.pm line 278" 14 | # which was noticed first around r266 (when Readonly::XS is not installed). 15 | # Looks like it only affects perl <5.8.8. It's not related to 16 | # the DB::DB workaround because it happens with use_db_sub=0 as well. 17 | # Readonly uses caller() to explicitly check where it's being called from: 18 | # my $whence = (caller 2)[3]; # Check if naughty user is trying to tie directly. 19 | # Readonly::croak "Invalid tie" unless $whence && $whence =~ /^Readonly::(?:Scalar1?|Readonly)$/; 20 | eval q{ 21 | Readonly::Scalar my $sca => 42; 22 | Readonly::Array my @arr => qw(A B C); 23 | Readonly::Hash my %has => (A => 1, B => 2); 24 | 1; 25 | } or die; 26 | #warn "ok - readonly\n"; 27 | } 28 | --------------------------------------------------------------------------------