Devel-Cover-1.08000755001750001750 012206216060 12607 5ustar00pjcjpjcj000000000000README100644001750001750 647612206216060 13565 0ustar00pjcjpjcj000000000000Devel-Cover-1.08NAME Devel::Cover - Code coverage metrics for Perl SYNOPSIS To get coverage for an uninstalled module: cover -test or cover -delete HARNESS_PERL_SWITCHES=-MDevel::Cover make test cover To get coverage for an uninstalled module which uses Module::Build (0.26 or later): ./Build testcover If the module does not use the t/*.t framework: PERL5OPT=-MDevel::Cover make test If you want to get coverage for a program: perl -MDevel::Cover yourprog args cover To alter default values: perl -MDevel::Cover=-db,cover_db,-coverage,statement,time yourprog args DESCRIPTION This module provides code coverage metrics for Perl. Code coverage metrics describe how thoroughly tests exercise code. By using Devel::Cover you can discover areas of code not exercised by your tests and determine which tests to create to increase coverage. Code coverage can be considered an indirect measure of quality. Although it is still being developed, Devel::Cover is now quite stable and provides many of the features to be expected in a useful coverage tool. Statement, branch, condition, subroutine, and pod coverage information is reported. Statement and subroutine coverage data should be accurate. Branch and condition coverage data should be mostly accurate too, although not always what one might initially expect. Pod coverage comes from Pod::Coverage. If Pod::Coverage::CountParents is available it will be used instead. Coverage data for other criteria are not yet collected. The cover program can be used to generate coverage reports. Devel::Cover ships with a number of different reports including various types of HTML output, textual reports, a report to display missing coverage in the same format as compilation errors and a report to display coverage information within the Vim editor. It is possible to add annotations to reports, for example you can add a column to an HTML report showing who last changed a line, as determined by git blame. Some annotation modules are shipped with Devel::Cover and you can easily create your own. The gcov2perl program can be used to convert gcov files to "Devel::Cover" databases. This allows you to display your C or XS code coverage together with your Perl coverage, or to use any of the Devel::Cover reports to display your C coverage data. Code coverage data are collected by replacing perl ops with functions which count how many times the ops are executed. These data are then mapped back to reality using the B compiler modules. There is also a statement profiling facility which should not be relied on. For proper profiling use Devel::NYTProf. Previous versions of Devel::Cover collected coverage data by replacing perl's runops function. It is still possible to switch to that mode of operation, but this now gets little testing and will probably be removed soon. You probably don't care about any of this. The most appropriate mailing list on which to discuss this module would be perl-qa. See . The Devel::Cover repository can be found at . This is also where problems should be reported. Changes100644001750001750 7243012206216060 14211 0ustar00pjcjpjcj000000000000Devel-Cover-1.08Devel::Cover history Release 1.08 - 24 August 2013 - Don't test against 5.17.x development releases. - Don't test against 5.19.2 and 5.19.3 which have a bug which causes tests to fail. - Perl 5.18 is more picky about POD encodings (Gregor Herrmann) (rt 88027). - Numerous typo fixes (David Steinbrunner) (github 67). Release 1.07 - 22 August 2013 - Improve -coverage options, fix -ignore_re for .gcov files (Steve Sanbeg) (github 53). - Work around B::CV::GV regression in 5.18.1. - Officially support 5.18.1. - Test against 5.19.1, 5.19.2 and 5.19.3. Release 1.06 - 17 July 2013 - More DEVEL_COVER_NO_TESTS changes for p5cover. Release 1.05 - 17 July 2013 - Quieten some deparse warnings. - Fix errors in write_csv (Jim Keenan) (github 64). - Fix error in -inc/+inc docs and pod formatting (Olaf Alders) (github 65). - Add DEVEL_COVER_NO_TESTS option to not run any tests during p5cover. Release 1.04 - 1 June 2013 - Fix return code from cover (Kan Fushihara) (guthub 61). - Fix pod coverage for multiple packages in a file. (rt 34888). - Speed improvements. Release 1.03 - 20 May 2013 - Fixes for correct operation with 5.17.11, 5.18.0 and 5.19.0. Release 1.02 - 28 April 2013 - Make -silent even quieter (Sergiy Borodych) (guthub 49). - mod_perl2 on Debian sets $^X to apache2 (Lasse Makholm) (github 47). - Add csv file for use with metacpan (Dinis Rebolo) (github 56). - cover -test exists with the staus of the underlying test run (Kan Fushihara) (github 57, 58). - Quieten a warning (Jim Keenan) (github 59). Release 1.01 - 30 March 2013 - Test against 5.14.4, 5.16.3, 5.17.8, 5.17.9 and 5.17.10. - Ignore PERL5OPT during tests. And other make targets. (rt 43833). - &&=, ||= and //= operators now require RHS to be true and false. - Fix some "uninitialized value" warnings. Release 1.00 - 10 February 2013 - Fix segv in constant folding of xor ops (github 40). - Fix various problems running Devel::Cover under tainting (github 41). - Add JavaScript to filter results in html_basic (David Cantrell) (github 42). Use -norestrict option to keep previous behaviour. - Document ability to mark code as uncoverable (github 45). Release 0.99 - 31 December 2012 - Improve documentation (Olaf Alders) (github 34). - Thank Bytemark for the cpancover server. - Test against 5.17.7. - Provide coverage for subs removed from the symbol table (rt 13207). Release 0.98 - 25 November 2012 - Fix links on html_basic report. - Fix setting Inc under taint mode (Guillaume Aubert) (guthub 26, 33). - Test against 5.17.6. - Improve warnings from Devel::Cover and reduce duplicates. - Make cover -test -nodelete work. - Run cpancover with 5.16.2. - Prefer bugs on github rather than RT. Release 0.97 - 10 November 2012 - Filter paths contained in CWD out of @Inc (Christian Walde) (github 32). - Test against 5.12.5, 5.14.3, 5.16.2, and 5.17.5. - Improve parallelism for cpancover. Release 0.96 - 24 September 2012 - JSON:PP should have been JSON::PP (Paul Hirst) (github 28). - Correct when some new tests should be skipped. - Quieten some debugging output. - Fix infinite loop during global destruction (github 29). Release 0.95 - 22 September 2012 - Fix loss of condition coverage data when first operand calls into ignored file (Celogeek, Christian Walde) (rt 63090) (github 15, 20). - Fix similar problem with branch coverage (Robert Freimuth) (rt 72027). - More similar problems (Brian Cassidy, Florian Ragwitz, Heikki J Laaksonen) (rt 63698). - Test against 5.17.4. Release 0.94 - 18 September 2012 - Officially support 5.16.1. - Manage mod_perl2 setting $^X to httpd. - Make changes to support 5.17.3. Release 0.93 - 4 August 2012 - Fix up start and finish times in text report. - Make summary cover report respect options given. - Make vim report respect specified criteria (rt 38258). - Only collect time and condition coverage when requested. - Fix some "ignoring extra $criterion" errors. - Don't stop reports at __END__ with AutoLoader. - Add perl version and OS to html_basic. - Make html_minimal summary more like html_basic. - Time coverage is no use in the vim report. - Keep descriptions to a single line. Release 0.92 - 17 July 2012 - Fix inc directories when working with local::lib (Olivier Mengué) (github 25) Release 0.91 - 15th July 2012 - Generate inc directories at runtime (rt 68991, 76528, 66881, 37349). - Get the tests running again on Windows. Release 0.90 - 13th July 2012 - Fix cover -test on Windows (Christian Walde) (github 24) (rt 75565). - Better document coverage options (github 23). - Run in directories containing spaces (rt 62423). - Add moose_constraint test (rt 57173). Release 0.89 - 15th June 2012 - Fix POD syntax error (gregor herrmann ) (rt 77599). - Handle RE metachars in build directory (rt 75633 & 77598) (dcoupal@cisco.com & Niko Tyni ). - Return to starting directory after cover report (John Lightsey) (rt 61515). - Relax permissions on DB directories (github 22). Release 0.88 - 8th June 2012 - Add -launch option to open report in appropriate viewer (Stephen Thirlwall). - Move ignored filename list into DB module (rt 77163 and github 12). - Don't complain about Mouse accessors (rt 71680). - Turn off $^W when calling B::Deparse (fixes perl #113464). - Update cpancover. Release 0.87 - 21st May 2012 - Major documentation overhaul (Pau Amma). - Cleanup Data::Dumper usage (localise settings) (Olivier Mengué) (rt 76531). - Ignore more generated filenames - Moose and Template Toolkit. - Improve results for chained logical operators. - Officially support 5.16.0. Release 0.86 - 9th April 2012 - Add all coverage criteria to the Vim report. Release 0.85 - 1st April 2012 - Add customisable thresholds to HTML reports (Xavier Caron). - Improve Vim report. Release 0.84 - 31th March 2012 - Add Vim report (based on discussion with Tatsuhiko Miyagawa). Release 0.83 - 30th March 2012 - Prefer JSON::XS for faster operation (Audrey Tang (唐鳳)). - Rework testing framework (Xavier Caron). Release 0.82 - 19th March 2012 - Do not distribute MYMETA.json (Olivier Mengué) (rt 75883). Release 0.81 - 18th March 2012 - Fix up dzil release process. Release 0.80 - 18th March 2012 - Don't be so noisy with Moose code. - Move to Dist:Zilla (Christian Walde). - Test against 5.14.2 and 5.15.2 - 5.15.8. - Select gcov2perl from the same directory as cover. - Print warnings to STDERR so $SIG{__WARN__} isn't called (Christian Walde). - Manage coverage reporting errors before an exec (Daisuke Maki). - Don't run fork tests on Windows (Christian Walde). - Add more documentation about cover --test (Kirk Kimmel). - Remove race conditions around mkdir. - Add travis config file. - Add word "Warning" to MD5 digest message. Release 0.79 - 5th August 2011 - Test against 5.12.4, 5.14.1, 5.15.0 and 5.15.1. - Fix inc_sub test failures dependant on whether JSON:PP was installed. Release 0.78 - 17th May 2011 - Fix up test quoting to work with Windows too. Release 0.77 - 15th May 2011 - Fix cover -test covering all the test files (Larry Leszczynski) (rt 65920). - Add DEVEL_COVER_IO_OPTIONS environment variable. - Sort runs by start time. - Add digests to DB. - Add cover -make option (Olivier Mengué) (rt 44906). - Add digests to DB. This should fix some problems related to losing coverage data when there are duplicate files. This happens most usually when modules are sometimes loaded from lib and sometimes from blib. (rt 14192, 32465, 45737). - Add branch coverage for gcov (rt 30365). Release 0.76 - 18th April 2011 - Move CHANGES file into root for search.cpan.org (rt 67541). - Add top level version subroutine (requested by H.Merijn Brand). - Add DEVEL_COVER_DB_FORMAT environment variable. - Add advisory locking to database IO operations. - Explain what to do if regexp_eval.t ever fails again (Florian Ragwitz). - Remove leftovers from PERL_OBJECT (Florian Ragwitz). - Recommend 5.8.8 and above - 5.8.7 is crashing so skip some tests there. Release 0.75 - 17th April 2011 - Write database as JSON if JSON::PP is available. Release 0.74 - 16th April 2011 - Test against 5.12.3 and code frozen 5.14.0 (unreleased). - Fix tests to work with all releases of 5.13.x (rt 64210, 60901). - Avoid race condition writing DB structure files (Nicholas Clark). - Add debuglog method to Devel::Cover::DB::Structure (Nicholas Clark). - Be more careful deleting DB structure files (Nicholas Clark). - Get cover -test to honour the db passed in. Release 0.73 - 2nd October 2010 - Tidy up Makefile.PL and META.yml. - Get coverage working with Windows again. Release 0.72 - 27th September 2010 - Teach cpancover how to work in parallel. - Improve speed of check_file() (Goro Fuji). - Fix errors with non-existent directories on Cygwin (Goro Fuji). - Improve self coverage with new test. - Fix tests to work with 5.13.5. - New dependency on Test::Warn. - New dependency on Parallel::Iterator for cpancover. Release 0.71 - 10th September 2010 - Improve running of Devel::Cover on itself. - Fix occasional parallel test failures. - Test against 5.12.2. Release 0.70 - 29th August 2010 - Get Devel::Cover working better on itself. - Distribution should now pass on 5.13.* development releases. Release 0.69 - 28th August 2010 - Correctly report on C and other shortcuts. - Put end to end tests in t/e2e. - Add test for regexp eval fail (Florian Ragwitz). - Fix some warnings from strict compilers (Florian Ragwitz). - Allow tests to run in parallel (Florian Ragwitz). - Test against 5.13.* development releases. - We now require Test::More to run the tests. Release 0.68 - 5th August 2010 - Fix gcov2perl to work with large numbers (Thomas Dorner) (rt 45028). - Fix "gcov -l" include files (Thomas Dorner) (rt 44864). - Test against 5.12.1. - Gross workaround for for regexp evals (Florian Ragwitz). Release 0.67 - 8th May 2010 - Fix up the Makefile for dmake on Strawberry Perl (Curtis Jewell) (rt 50774). Release 0.66 - 12th April 2010 - Move to faster method of collecting data. Could be up to twice as fast now. - Add -replace_ops options to be able to revert to previous collection method. - Test against 5.12.0 and update tests as necessary. - Work better with non-existent databases. - XS fixes related to overriding ops rather than replacing runops (Florian Ragwitz). - Don't chmod created directories (mkdir should suffice). Release 0.65 - 8th August 2009 - Fix uninitialised value warning (reported by Andrew Billeb). - Test against 5.8.9 and 5.10.1 (RC1). - Correct deparsed conditional output in elsif conditions. - Unset PERL5OPT when running tests. Release 0.64 - 10th April 2008 - Build on Windows. - Make "cover -test" work for Module::Build (Michael G Schwern) (rt 34263). - Make "cover -test" cover .[ch] files (Michael G Schwern) (rt 34262). - Make "cover -gcov" a valid option (Michael G Schwern) (rt 34261). Release 0.63 - 16th November 2007 - require 5.006001 might stop CPAN testers trying to test with 5.005. - store_return() should be a void function (H.Merijn Brand). - Finish dor support. - Add support for exec (Brandon Black). - Tested against 5.10 (RC1). Release 0.62 - 5th November 2007 - Add table sorting to Html_basic report (Nathan Haigh). - Assume heredocs are constants. - Don't add 0x200 to $^P ("file" names for evals) (Fix for Template::Declare). - Add timer and alarm for cpancover. - Add Report Date to basic html report. - Quieten some warnings. - Document cover -test. - Get rid of any __DIE__and __WARN__ signals during the report. - Don't try to get a digest for "-e". - Tidy up filename normalisation. - Be more explicit about what I mean when I call this alpha software. - Add uncoverable comments. - Don't complain about POSIX.pm (Erwan Lemonnier). - Don't resolve pathnames of symbolic links (Stefan Becker). - Spelling nits (James E Keenan). Release 0.61 - 10th January 2007 - Fix some "ignored" errors due to multiple subs of the same name on the same line (rt 14192). - Display pod coverage with subroutine coverage in text report. - Update golden output (tests were failing in 0.60). Release 0.60 - 2nd January 2007 - Simplify get_key function and remove TODO item (Gisle Aas). - Be careful with UNC paths on Windows (John LoVerso) (rt 24105). - Only call HvSHAREKEYS_off if threading is enabled. - s/unvailable/unavailable/ (Jim Cromie). - Don't key on op_targ - it might change (rt 22701). - Tidy up docs and error messages for reports (rt 21098). - Better database validation. - Don't delete invalid datbases (rt 16039). - Tested against 5.9.5. - Allow for new anonlist and anonhash ops (rt 24067). - Use outputfile for both cover and cpancover. - Add compilation report (Denis Howe). Release 0.59 - 23rd August 2006 - Tidy up HTML, especially for cpancover. - Allow coverage of subroutine statements in a different file (as with Mason) (clkao). - Bump refcount on subs to ensure they stay around for us to look at them (yes, this is a hack). Release 0.58 - 6th August 2006 - Be more clever about void context and so avoid SvROK hack. - Document some bugs, limitations and requirements. - HTML alignment fix (Sébastien Aperghis-Tramoni). - CSS improvements for HTML reports (Sébastien Aperghis-Tramoni). Release 0.57 - 3rd August 2006 - Report Pod::Coverage load failure (dom - happygiraffe.net) (rt 14425). - Use Perl::Tidy as an alternative syntax highlighter (Sébastien Aperghis-Tramoni). - Lighten the style a little - make table cells only have right and bottom borders, using the ones from the surrounding cells to form the grid (Sébastien Aperghis-Tramoni). - subs_only option to only show coverage for subs (Nicholas Clark). Release 0.56 - 1st August 2006 - gcov2perl creates db if necessary (Steve Peters) (rt 13536). - Properly merge identical files (Jeff Wren) (rt 12410). - Allow line achors in html_basic (Mark Stosberg) (rt 13615). - Right justify numerical tabular html output (Sébastien Aperghis-Tramoni). - Work around ExtUtils::MakeMaker realclean bug (Florian Ragwitz) (rt 17324). - Don't try to delete db if it isn't there. - The following changes were made at the Devel::Cover hackathon, sponsored by Best Practical. - No longer create the temporary .version files (Leon Brocard). - Document Module::Build's testcover (Leon Brocard). - Add more detail about code coverage in docs (Leon Brocard). - Make the HTML valid by moving comment past the (Leon Brocard). - Add syntax highlighting to HTML_basic if PPI::HTML is installed (Leon Brocard). - Refactored common code for calculate_summary across all Criterion classes (Norman Nunley). - Remove duplicated code paths between Branch and Condition (Norman Nunley). - Don't call overload bool in condition coverage (clkao). - Fix the XML comment for cpancover (Norman Nunley). - Turn conditionals in void context into or2 conditions so that the value of the RHS doesn't matter for coverage purposes. - Add a tool to scan comments about uncoverable code and output .uncoverable format to stdout (clkao). - Add and update overload tests. Release 0.55 - 22nd September 2005 - Add -gcov option to cover and make it default when using gcc. - Remolve unused File::Find from cpancover. - Document how to get XS coverage in gcov2perl. - Improvements to SVK annotation (Chia-liang Kao). Release 0.54 - 13th September 2005 - Make html_basic prettier. - Fix pod coverage percentages. - Fix integer <-> pointer conversion warnings (Robin Barker). - Add more tests for sort bug fixed in 0.53 (Rob Kinyon). - Handle || bless {}, "XXX" (reported by Marcel Grünauer). - Add preliminary dor support (unfinished). - Test against perl-5.8.7. - Add check for Pod::Coverage::CountParents. - Fix line number display problem in conditionals in Html_basic. - Add eval_sub and eval3 tests. - Add buildperl script. - Add -report option to cpancover. - Update cpancover CSS. - Partial solution for structure problems including debugging code. - Add outputfile option to Html_basic. Release 0.53 - 17th April 2005 - Clean up database directories. - Allow require File::Spec->catfile('t', 'common.pl'); (from an example by Randy W. Sims). - Fix core dump associated with sort subs and add test case supplied by Leif Eriksen. - Add extra options for coverage criteria. - Allow pod coverage options to be specified. - Update copyrights. - Allow Test::Differences output to be displayed usefully. - Test against perl-5.9.3. Release 0.52 - 13th December 2004 - Fix thread locking bug (Ruslan Zakirov). - Make valgrind happy. - Fix gcov2perl (Steve Peters). - Restore failure message to CLONE. Release 0.51 - 29th November 2004 - Handle $y || undef. - Small branch coverage fix. - Improve reporting of uncoverable constructs in html reports. - Test against perl-5.8.6. - Recommend at least perl-5.8.2. Release 0.50 - 25th October 2004 - Add -test option to cover. - Fix missing coverage when calling a sub in an ignored module. - Add module_ignore test. - Add uncoverable options to cover. Release 0.49 - 6th October 2004 - Compile on Win32 (and elsewhere) (Steve Hay). Release 0.48 - 5th October 2004 - Working towards thread safety. - Test against perl-5.8.5. - Store perl version number in Inc.pm and complain if it doesn't match. - Add annotation API and Random example. - Display run information in text report. - Remove POSIX path bodge which is now properly fixed. - Update test results for new functionality. - Add -select_re and -ignore_re options to cover. - Sort out "ignoring extra subroutine" and friends. - Add eval2 and eval_use tests. - Ignore *.t by default with blib. - Add beginnings of sort report. - Bump up DB version. - Fix problems with references in INC (which can't be handled). - Fixes for mod_perl (Vadim O. Ustiansky). Release 0.47 - 27th June 2004 - Provide subroutine coverage for empty subs - sub empty { }. - Only override B::Deparse subs whilst using them and add deparse test. Release 0.46 - 23rd June 2004 - Don't lose data merging DBs. - Work with Safe.pm, by not covering it. - Swap Profiling_op for Profiling_key to avoid accessing freed memory. - Rename -file and -exclude options in cover to -select and -ignore. - Fully cover conditions and branches when the condition calls a sub in an ignored file. Release 0.45 - 27th May 2004 - Cope with spaces in build path on Windows (Max Maischein). - Allow Devel::Cover to be used under mod_perl (Philippe M. Chiasson). - Handle $x ||= 1 and friends nicely, including subs and *foo{THING}. - Allow uncoverable code to be specified. (Unfinished) Release 0.44 - 18th May 2004 - Fix get_elapsed, although its result is not used yet. - Recommend 5.8.1 as a minimum. - Replace run Makefile target with text and html. - Fix up gcov2perl. - Fail gracefully when covering a threaded program. - Add DEVEL_COVER_OPTIONS environment variable. Release 0.43 - 2nd May 2004 - Add +ignore and +select options, and change meaning of -ignore and -select options. This is an interface change. - Ignore coverage on Devel::Cover's files by default. - Cover INIT and END blocks more reliably. - Fix 5.6 on Windows. Well, sort of. - Add a message in Makefile.PL recommending against using Devel::Cover on 5.6, especially under Windows. Release 0.42 - 30th April 2004 - Add SYNOPSIS section to README. - Resolve links for Devel::Cover::Inc (Dave Rolsky). - Get things running on Windows again. Release 0.41 - 29th April 2004 - Correct time coverage percentages. - Collect data for BEGIN, CHECK, INIT and END blocks in the main program, and INIT and END blocks in modules. - Ensure our END block is always the last run. - Don't clean up Pending_conditionals data. - Untaint @INC after using blib. - Be silent if called via HARNESS_PERL_SWITCHES. - Test against perl-5.8.4. - Store cwd from when each module was required in order to find them again. - Refactor and tidy XS code. - Get cpancover running again with the DB changes. - Normalise filenames. Release 0.40 - 24th March 2004 - Remove DB structure for unwanted files. - Identify ops based on address and OP contents, except for op_ppaddr, which we modify. - Overhaul of coverage collection. - Additions to tests. Release 0.39 - 22nd March 2004 - Major database rework to store runs. - Add Devel::Cover::DB::Structure.pm. - Check for Test::Differences in Makefile.PL. - Test with perl5.9.2. - Skip fork test on MSWin32. Release 0.38 - 12th March 2004 - Allow coverage summary title to be changed (David Wheeler). - More care generating pod golden results. - Small Devel::Cover::Op output fix. - Handle "my $x = shift || []" and friends nicely. - Add default_param test. - Provide summary output to one decimal place. - Update gcov2perl. Release 0.37 - 10th March 2004 - Fix up pod test golden results. - Add limitation documentation (Michael Carman). Release 0.36 - 9th March 2004 - Add fork test. - Remove debugging code from md5 test. - Remove runs after merging - code was commented out for debugging. - Don't merge runs during coverage collection. - Delete database at start if not merging to cope with forking. Release 0.35 - 8th March 2004 - Change Text2 to pick up version changes. - Minor documentation updates. - Minor changes to Devel::Cover::Op. - Add outputfile option to HTML output (David Wheeler). - Document -silent option to Devel::Cover. - Add -silent option to cover (David Wheeler). - Make Devel::Cover taint safe, or tolerant at least. - Only add versioned golden results to tests that need them. - Add trivial, md5 and module_no_inc tests. - Increase flexibility of testing system to accomodate md5 test. - Add mani, all_gold and all_test Makefile targets. - Make all_versions skip non-existent platforms. - Add DB option to make dump target. - Remove dependencies on op_seq. (I removed it from bleadperl.) Use op_targ instead. - Collect some metadata. - Documentation updates (Andy Lester). - Document the mechanism by which files are selected for coverage. Release 0.34 - 14th January 2004 - Fix various warnings and errors that had crept in whilst working on dynamic subs. Release 0.33 - 13th January 2004 - Get things working on paths with spaces in them. - Documentation clarifications (Andy Lester). - Fix coverage for simple if, elsif and unless conditionals. - Add if test. - Ensure runs are merged in the order they were created. - Don't report multiple data from dynamically created subs. - Add alias, alias1 and dynamic_subs tests. - Fix and document Devel::Cover::Op. - Redo subroutine coverage so anon subs are covered correctly in 5.6.x. Release 0.32 - 4th January 2004 - Actually include do test. - Create run concept in database. - Belatedly remove check for Template. - Add branch_return_sub test. - Add finalise_conditions() to collect previously missed coverage. - Fix incorrect coverage results associated with "and" conditions. - Add all_versions utility script. - Put /usr/bin/perl on all shebang lines. Release 0.31 - 22nd December 2003 - Remove debugging output. Hmmm. Release 0.30 - 22nd December 2003 - Get things working under Windows. Release 0.29 - 19th December 2003 - Merge data from files with identical MD5 checksums (Arthur Bergman). - Add do test. - Handle $x || return. - Keep cover -delete happy when there is no existing database. - In cover, make -file a glob and add -exclude. - Watch for coverage options being set in cover (PERL5OPT set?). - Fix up html_basic and html_subtle. - Make 5.6.x builds a bit quieter. - Clean up time routines in XS code. Release 0.28 - 1st December 2003 - Remove leading whitespace from HTML templates (Gabor Szabo). - Remove obsolete indent option. - Add MD5 checksums (Michael Carman). - Add Html_minimal.pm (Michael Carman) (Obsoleting Gabor's patch before it was released). - Pass unknown cover options to the formatter and remove -option. - Specify the output directory for HTML. - Search up directory trees for modules. Release 0.27 - 9th November 2003 - Behave sensibly if import() is not called, for example when MakeMaker does a PREREQ_PM check. - Use Storable for the database instead of Data::Dumper/eval (Michael Carman). Release 0.26 - 12th October 2003 - Decline to output HTML results for conditions containing > 16 terms. - Add titles to HTML output. Release 0.25 - 10th October 2003 - Fix for perl 5.6.1. Cwd::abs_path($d) gets upset if $d doesn't exist. - Start of some changes to cpancover HTML. Release 0.24 - 10th October 2003 - Paths in Devel::Cover::Inc in single quotes for Windows platforms. - Add -dir option and default it to cwd. - Ignore test.pl in cpancover. - Display pod coverage in cpancover. Release 0.23 - 6th September 2003 - Report condition coverage for branches on the same line as the branch. - Add subroutine coverage. - Made "all" coverage value work and made it the default. Release 0.22 - 2nd September 2003 - Rewrite runops function. - First line of DESTROY blocks and overload subs not now skipped. - Add some more tests. Release 0.21 - 1st September 2003 - Add cpancover. - Handle $x || next and friends. - Add html_subtle and text2 backends (Michael Carman). - Rename html backend to html_basic. - Make html backend a wrapper around preferred style, currently html_subtle. - Make time coverage a little more accurate. OK, a lot more accurate, it's at least on the right line now, but I still wouldn't really trust it. - Fix pod coverage which has been broken for a while. - Don't collect branch coverage when not asked for. - Provide golden results for different Perl versions. - Change some B::Deparse logic to mirror changes in 5.8.1/5.10. Release 0.20 - 5th October 2002 - Add break after default to satisfy IBM's xlC compiler on AIX. - Get things working with threads again. - make realclean is. Release 0.19 - 29th September 2002 - Quieten uninitialised value warnings. Release 0.18 - 28th September 2002 - Redo the way condition coverage is gathered - abuse op_ppaddr. - Put or conditions the right way round. - Allow for subclasses of coverage types. - Add: Devel::Cover::Condition_or_2.pm Devel::Cover::Condition_or_3.pm Devel::Cover::Condition_and_3.pm Devel::Cover::Condition_xor_4.pm - "use" all conditions in Criterion.pm, and nowhere else. - Add support for xor, ||= and &&=. Release 0.17 - 15th September 2002 - Call check_files() in report() to ensure we pick up anything added to the symbol table while the program was running. Release 0.16 - 9th September 2002 - Get rid of some uninitialised warnings. - Inline the HTML templates. - Rebless the op after blessing it as a COP. - Make branch coverage line numbers more accurate. Release 0.15 - 5th September 2002 - Reinstate coverage of subs in main:: which got lost somewhere (0.11?). - Bug fixes for use of uninitialised values. - Automatically generate tests. Well, their infrastructure anyway. - Move Cover to lib/Devel/Cover to keep case insensitive filesystems happy. - Remove -detail option. (It belongs to cover.) - Work on op addresses and sequence numbers instead of just op addresses, to be (almost) unique. - Clean up subroutine location code. - Fix -select to override anything else. - Add condition coverage for && and || ops. - Various changes in runops_cover to try to reduce runtime. - Don't use runops_cover until CHECK time. - Add merge, write and file options to cover. - Add branch coverage. - Abstract away cover backends. - Use TT for HTML output. Release 0.14 - 28th February 2002 - Add a workaround for an AUTOLOAD bug in bleadperl. - Add gcov2perl program to convert gcov files to Devel::Cover databases. - Get rid of // comments in xs file. Release 0.13 - 14th October 2001 - Forgot to allow for lack of Pod::Coverage in Devel::Cover::Pod.pm. Release 0.12 - 14th October 2001 - Improve pod coverage by considering private subs. - Add time coverage, aka profiling. - Add: Devel::Cover::DB::File.pm Devel::Cover::Time.pm - Abstract summary and percentage calculations to appropriate classes. Release 0.11 - 10th September 2001 - Add pod coverage based on Pod::Coverage.pm. - Put a full API on the database. - Add: Devel::Cover::Criterion.pm Devel::Cover::Statement.pm Devel::Cover::Condition.pm Devel::Cover::Pod.pm - Some improvements to the cover program. Release 0.10 - 27th August 2001 - Add cover program to generate reports. Release 0.09 - 18th August 2001 - Beef up Devel::Cover::DB. Release 0.08 - 18th August 2001 - Provide better handling of files to report on or ignore. Makefile.PL generates Inc.pm containing default @INC. added +inc, -ignore and -select. Release 0.07 - 17th August 2001 - Add an API to Devel::Cover::DB. Release 0.06 - 10th August 2001 - Rename Devel::Cover::Process to Devel::Cover::DB - Make the database a directory. - Add fix for eval in filename. (Arthur Bergman ) - Add more tests and abstract away comparison subroutine. - Clear @Inc if it is set explicitly. - Trim filename length in detailed output. Release 0.05 - 9th August 2001 - Make line numbers more accurate when nextstate has been optimised away. - Get things working with ithreads. Release 0.04 - 12th April 2001 - Include Devel::Cover::Op - Add condition coverage (sort of). Release 0.03 - 10th April 2001 - Add detailed output. - Add -d option to turn it on. Release 0.02 - 10th April 2001 - Add summary output. - Add -S option to turn it off. - Turn Devel::Cover::Process into a class. Release 0.01 - Initial release - 9th April 2001 dist.ini100644001750001750 605212206216060 14337 0ustar00pjcjpjcj000000000000Devel-Cover-1.08name = Devel-Cover abstract = Code coverage metrics for Perl author = Paul Johnson license = Perl_5 copyright_holder = Paul Johnson [VersionFromScript] ; the version is stored in Makefile.PL script = make show_version [Run::BeforeBuild] ; commands to run before build phase run = make README [GatherDir] ; gather files from the dist dir include_dotfiles = 1 [ManifestSkip] ; remove gathered files specified by MANIFEST.SKIP [ExecDir] ; mark bin as the dir to contain scripts [OurPkgVersion] ; add versions to the packages [PodVersion] ; add versions to the POD of packages [MetaYAML] ; create META.yml [MetaJSON] ; create META.json [MetaConfig] ; add dzil info to meta files [MetaResources] ; add resources to meta files homepage = http://www.pjcj.net/perl.html bugtracker.web = https://github.com/pjcj/Devel--Cover/issues license = http://dev.perl.org/licenses repository.url = http://github.com/pjcj/Devel--Cover repository.web = http://github.com/pjcj/Devel--Cover repository.type = git x_mailing_list = http://lists.perl.org/list/perl-qa.html [MetaNoIndex] directory = tests directory = t directory = utils ; [License] ; add LICENSE file [Manifest] ; builds the manifest from the gathered files [Prereqs] perl = 5.006001 Storable = 0 Digest::MD5 = 0 [Prereqs / Recommends] perl = 5.008002 Template = 2.00 PPI::HTML = 1.07 Perl::Tidy = 20060719 Pod::Coverage = 0.06 Pod::Coverage::CountParents = 0 Parallel::Iterator = 0 JSON::PP = 0 Test::Differences = 0 ; make sure it gets added Browser::Open = 0 [Prereqs / ConfigureRequires] ExtUtils::MakeMaker = 0 [Prereqs / TestRequires] Test::More = 0 Test::Warn = 0 [Prereqs / TestRecommends] Test::Differences = 0 [Run::Test] run = perl Makefile.PL && make t [Git::Check] ; [CheckChangesHasContent] ; ensure Changes has been updated [NextRelease] ; fixes up the Changes file format = Release %v - %{d}d %{MMMM yyyy}d ; needs to be in this order [Git::Commit] ; check the release in [Git::Tag] ; and tag it [TestRelease] ; tests the dist before releasing [ConfirmRelease] ; asks for manual confirmation of release [UploadToCPAN] ; uploads to cpan ; [Git::Push] ; push to remote repository - hangs for me ; [Run::AfterBuild] ; run = chdir %d && %x -e 'rename "LICENSE" => "LICENCE"' # yeah, yeah, yeah ; following can do stuff, but aren't used yet ; [ExtraTests] ; [PruneCruft] ; [ShareDir] ; [InsertCopyright] ; [EOLTests] ; [FakeFaker] ; [LocalBrew] ; [Bugtracker] ; [InstallGuide] Cover.xs100644001750001750 11263412206216060 14371 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/* * Copyright 2001-2013, Paul Johnson (paul@pjcj.net) * * This software is free. It is licensed under the same terms as Perl itself. * * The latest version of this software should be available from my homepage: * http://www.pjcj.net * */ #ifdef __cplusplus extern "C" { #endif #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #ifdef PERL_OBJECT #define CALLOP this->*PL_op #else #define CALLOP *PL_op #endif #ifndef START_MY_CXT /* No threads in 5.6 */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif #define MY_CXT_KEY "Devel::Cover::_guts" XS_VERSION #define PDEB(a) a #define NDEB(a) ; #define D PerlIO_printf #define L Perl_debug_log #define svdump(sv) do_sv_dump(0, L, (SV *)sv, 0, 10, 1, 0); #define None 0x00000000 #define Statement 0x00000001 #define Branch 0x00000002 #define Condition 0x00000004 #define Subroutine 0x00000008 #define Path 0x00000010 #define Pod 0x00000020 #define Time 0x00000040 #define All 0xffffffff #define CAN_PROFILE defined HAS_GETTIMEOFDAY || defined HAS_TIMES struct unique /* Well, we'll be fairly unlucky if it's not */ { OP *addr, op; }; #define KEY_SZ sizeof(struct unique) typedef struct { unsigned covering; int collecting_here; HV *cover, *statements, *branches, *conditions, #if CAN_PROFILE *times, #endif *modules, *files; AV *ends; char profiling_key[KEY_SZ]; bool profiling_key_valid; SV *module, *lastfile; int tid; int replace_ops; /* - fix up whatever is broken with module_relative on Windows here */ #if PERL_VERSION > 8 Perl_ppaddr_t ppaddr[MAXO]; #else OP *(*ppaddr[MAXO])(pTHX); #endif } my_cxt_t; #ifdef USE_ITHREADS static perl_mutex DC_mutex; #endif static HV *Pending_conditionals, *Return_ops; static int tid; START_MY_CXT #define collecting(criterion) (MY_CXT.covering & (criterion)) #ifdef HAS_GETTIMEOFDAY #ifdef __cplusplus extern "C" { #endif #ifdef WIN32 #include #else #include #endif #ifdef __cplusplus } #endif static double get_elapsed() { #ifdef WIN32 dTHX; #endif struct timeval time; double e; gettimeofday(&time, NULL); e = time.tv_sec * 1e6 + time.tv_usec; return e; } static double elapsed() { static double p; double e, t; t = get_elapsed(); e = t - p; p = t; return e; } #elif defined HAS_TIMES #ifndef HZ # ifdef CLK_TCK # define HZ CLK_TCK # else # define HZ 60 # endif #endif static int cpu() { #ifdef WIN32 dTHX; #endif static struct tms time; static int utime = 0, stime = 0; int e; #ifndef VMS (void)PerlProc_times(&time); #else (void)PerlProc_times((tbuffer_t *)&time); #endif e = time.tms_utime - utime + time.tms_stime - stime; utime = time.tms_utime; stime = time.tms_stime; return e / HZ; } #endif /* HAS_GETTIMEOFDAY */ static char *get_key(OP *o) { static struct unique uniq; uniq.addr = o; uniq.op = *o; uniq.op.op_ppaddr = 0; /* we mess with this field */ uniq.op.op_targ = 0; /* might change */ return (char *)&uniq; } static char *hex_key(char *key) { static char hk[KEY_SZ * 2 + 1]; unsigned int c; for (c = 0; c < KEY_SZ; c++) { NDEB(D(L, "%d of %d, <%02X> at %p\n", c, KEY_SZ, (unsigned char)key[c], hk + c * 2)); sprintf(hk + c * 2, "%02X", (unsigned char)key[c]); } hk[c * 2] = 0; return hk; } static void set_firsts_if_needed(pTHX) { SV *init = (SV *)get_cv("Devel::Cover::first_init", 0); SV *end = (SV *)get_cv("Devel::Cover::first_end", 0); NDEB(svdump(end)); if (PL_initav && av_len(PL_initav) >= 0) { SV **cv = av_fetch(PL_initav, 0, 0); if (*cv != init) { av_unshift(PL_initav, 1); av_store(PL_initav, 0, init); } } if (PL_endav && av_len(PL_endav) >= 0) { SV **cv = av_fetch(PL_endav, 0, 0); if (*cv != end) { av_unshift(PL_endav, 1); av_store(PL_endav, 0, end); } } } static int check_if_collecting(pTHX_ COP *cop) { dMY_CXT; #if !NO_TAINT_SUPPORT int tainted = PL_tainted; #endif char *file = CopFILE(cop); int in_re_eval = strnEQ(file, "(reeval ", 8); NDEB(D(L, "check_if_collecting at: %s:%ld\n", file, CopLINE(cop))); if (file && strNE(SvPV_nolen(MY_CXT.lastfile), file)) { int found = 0; if (MY_CXT.files) { SV **f = hv_fetch(MY_CXT.files, file, strlen(file), 0); if (f) { MY_CXT.collecting_here = SvIV(*f); found = 1; NDEB(D(L, "File: %s:%ld [%d]\n", file, CopLINE(cop), MY_CXT.collecting_here)); } } if (!found && MY_CXT.replace_ops && !in_re_eval) { dSP; int count; SV *rv; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(file, 0))); PUTBACK; count = call_pv("Devel::Cover::use_file", G_SCALAR); SPAGAIN; if (count != 1) croak("use_file returned %d values\n", count); rv = POPs; MY_CXT.collecting_here = SvTRUE(rv) ? 1 : 0; NDEB(D(L, "-- %s - %d\n", file, MY_CXT.collecting_here)); PUTBACK; FREETMPS; LEAVE; } sv_setpv(MY_CXT.lastfile, file); } NDEB(D(L, "%s - %d\n", SvPV_nolen(MY_CXT.lastfile), MY_CXT.collecting_here)); #if PERL_VERSION > 6 if (SvTRUE(MY_CXT.module)) { STRLEN mlen, flen = strlen(file); char *m = SvPV(MY_CXT.module, mlen); if (flen >= mlen && strnEQ(m, file + flen - mlen, mlen)) { SV **dir = hv_fetch(MY_CXT.modules, file, strlen(file), 1); if (!SvROK(*dir)) { SV *cwd = newSV(0); AV *d = newAV(); *dir = newRV_inc((SV*) d); av_push(d, newSVsv(MY_CXT.module)); if (getcwd_sv(cwd)) { av_push(d, newSVsv(cwd)); NDEB(D(L, "require %s as %s from %s\n", m, file, SvPV_nolen(cwd))); } } } sv_setpv(MY_CXT.module, ""); set_firsts_if_needed(aTHX); } #endif #if !NO_TAINT_SUPPORT PL_tainted = tainted; #endif return MY_CXT.collecting_here; } #if CAN_PROFILE static void cover_time(pTHX) { dMY_CXT; SV **count; NV c; if (collecting(Time)) { /* * Profiling information is stored against MY_CXT.profiling_key, * the key for the op we have just run. */ NDEB(D(L, "Cop at %p, op at %p\n", PL_curcop, PL_op)); if (MY_CXT.profiling_key_valid) { count = hv_fetch(MY_CXT.times, MY_CXT.profiling_key, KEY_SZ, 1); c = (SvTRUE(*count) ? SvNV(*count) : 0) + #if defined HAS_GETTIMEOFDAY elapsed(); #else cpu(); #endif sv_setnv(*count, c); } if (PL_op) { memcpy(MY_CXT.profiling_key, get_key(PL_op), KEY_SZ); MY_CXT.profiling_key_valid = 1; } else MY_CXT.profiling_key_valid = 0; } } #endif static int collecting_here(pTHX) { dMY_CXT; if (MY_CXT.collecting_here) return 1; #if CAN_PROFILE cover_time(aTHX); MY_CXT.profiling_key_valid = 0; #endif NDEB(D(L, "op %p is %s\n", PL_op, OP_NAME(PL_op))); if (hv_exists(Return_ops, get_key(PL_op), KEY_SZ)) return MY_CXT.collecting_here = 1; else return 0; } static void store_return(pTHX) { dMY_CXT; /* * If we are jumping somewhere we might not be collecting * coverage there, so store where we will be coming back to * so we can turn on coverage straight away. We need to * store more than one return op because a non collecting * sub may call back to a collecting sub. */ if (MY_CXT.collecting_here && PL_op->op_next) { (void)hv_fetch(Return_ops, get_key(PL_op->op_next), KEY_SZ, 1); NDEB(D(L, "adding return op %p\n", PL_op->op_next)); } } static void store_module(pTHX) { dMY_CXT; dSP; SvSetSV_nosteal(MY_CXT.module, TOPs); NDEB(D(L, "require %s\n", SvPV_nolen(MY_CXT.module))); } static void call_report(pTHX) { dSP; PUSHMARK(SP); call_pv("Devel::Cover::report", G_VOID|G_DISCARD|G_EVAL); SPAGAIN; } static void cover_statement(pTHX_ OP *op) { dMY_CXT; char *ch; SV **count; IV c; if (!collecting(Statement)) return; ch = get_key(op); count = hv_fetch(MY_CXT.statements, ch, KEY_SZ, 1); c = SvTRUE(*count) ? SvIV(*count) + 1 : 1; NDEB(D(L, "Statement: %s:%ld\n", CopFILE(cCOPx(op)), CopLINE(cCOPx(op)))); sv_setiv(*count, c); NDEB(op_dump(op)); } static void cover_current_statement(pTHX) { #if CAN_PROFILE cover_time(aTHX); #endif cover_statement(aTHX_ PL_op); } static void add_branch(pTHX_ OP *op, int br) { dMY_CXT; AV *branches; SV **count; int c; SV **tmp = hv_fetch(MY_CXT.branches, get_key(op), KEY_SZ, 1); if (SvROK(*tmp)) branches = (AV *) SvRV(*tmp); else { *tmp = newRV_inc((SV*) (branches = newAV())); av_unshift(branches, 2); } count = av_fetch(branches, br, 1); c = SvTRUE(*count) ? SvIV(*count) + 1 : 1; sv_setiv(*count, c); NDEB(D(L, "Adding branch making %d at %p\n", c, op)); } static AV *get_conditional_array(pTHX_ OP *op) { dMY_CXT; AV *conds; SV **cref = hv_fetch(MY_CXT.conditions, get_key(op), KEY_SZ, 1); if (SvROK(*cref)) conds = (AV *) SvRV(*cref); else *cref = newRV_inc((SV*) (conds = newAV())); return conds; } static void set_conditional(pTHX_ OP *op, int cond, int value) { /* * The conditional array comprises six elements: * * 0 - 1 iff we are in an xor and the first operand was true * 1 - not short circuited - second operand is false * 2 - not short circuited - second operand is true * 3 - short circuited, or for xor second operand is false * 4 - for xor second operand is true * 5 - 1 iff we are in void context */ SV **count = av_fetch(get_conditional_array(aTHX_ op), cond, 1); sv_setiv(*count, value); NDEB(D(L, "Setting %d conditional to %d at %p\n", cond, value, op)); } static void add_conditional(pTHX_ OP *op, int cond) { SV **count = av_fetch(get_conditional_array(aTHX_ op), cond, 1); int c = SvTRUE(*count) ? SvIV(*count) + 1 : 1; sv_setiv(*count, c); NDEB(D(L, "Adding %d conditional making %d at %p\n", cond, c, op)); } #ifdef USE_ITHREADS static AV *get_conds(pTHX_ AV *conds) { dMY_CXT; AV *thrconds; HV *threads; SV *tid, **cref; char *t; if (av_exists(conds, 2)) { SV **cref = av_fetch(conds, 2, 0); threads = (HV *) *cref; } else { threads = newHV(); HvSHAREKEYS_off(threads); av_store(conds, 2, (SV *)threads); } tid = newSViv(MY_CXT.tid); t = SvPV_nolen(tid); cref = hv_fetch(threads, t, strlen(t), 1); if (SvROK(*cref)) thrconds = (AV *)SvRV(*cref); else *cref = newRV_inc((SV*) (thrconds = newAV())); return thrconds; } #endif static void add_condition(pTHX_ SV *cond_ref, int value) { int final = !value; AV *conds = (AV *) SvRV(cond_ref); OP *next = INT2PTR(OP *, SvIV(*av_fetch(conds, 0, 0))); OP *(*addr)(pTHX) = INT2PTR(OP *(*)(pTHX), SvIV(*av_fetch(conds, 1, 0))); I32 i; if (!final && next != PL_op) croak("next (%p) does not match PL_op (%p)", next, PL_op); #ifdef USE_ITHREADS i = 0; conds = get_conds(aTHX_ conds); #else i = 2; #endif NDEB(D(L, "Looking through %d conditionals at %p\n", av_len(conds) - 1, PL_op)); for (; i <= av_len(conds); i++) { OP *op = INT2PTR(OP *, SvIV(*av_fetch(conds, i, 0))); SV **count = av_fetch(get_conditional_array(aTHX_ op), 0, 1); int type = SvTRUE(*count) ? SvIV(*count) : 0; sv_setiv(*count, 0); /* Check if we have come from an xor with a true first op */ if (final) value = 1; if (type == 1) value += 2; NDEB(D(L, "Found %p: %d, %d\n", op, type, value)); add_conditional(aTHX_ op, value); } #ifdef USE_ITHREADS i = -1; #else i = 1; #endif while (av_len(conds) > i) av_pop(conds); NDEB(svdump(conds)); NDEB(D(L, "addr is %p, next is %p, PL_op is %p, length is %d final is %d\n", addr, next, PL_op, av_len(conds), final)); if (!final) next->op_ppaddr = addr; } static void dump_conditions(pTHX) { HE *e; MUTEX_LOCK(&DC_mutex); hv_iterinit(Pending_conditionals); PDEB(D(L, "Pending_conditionals:\n")); while ((e = hv_iternext(Pending_conditionals))) { I32 len; char *key = hv_iterkey(e, &len); SV *cond_ref = hv_iterval(Pending_conditionals, e); AV *conds = (AV *) SvRV(cond_ref); OP *next = INT2PTR(OP *, SvIV(*av_fetch(conds, 0,0))); OP *(*addr)(pTHX) = INT2PTR(OP *(*)(pTHX), SvIV(*av_fetch(conds, 1,0))); I32 i; #ifdef USE_ITHREADS i = 0; /* TODO - this can't be right */ conds = get_conds(aTHX_ conds); #else i = 2; #endif PDEB(D(L, " %s: op %p, next %p (%d)\n", hex_key(key), next, addr, av_len(conds) - 1)); for (; i <= av_len(conds); i++) { OP *op = INT2PTR(OP *, SvIV(*av_fetch(conds, i, 0))); SV **count = av_fetch(get_conditional_array(aTHX_ op), 0, 1); int type = SvTRUE(*count) ? SvIV(*count) : 0; sv_setiv(*count, 0); PDEB(D(L, " %2d: %p, %d\n", i - 2, op, type)); } } MUTEX_UNLOCK(&DC_mutex); } /* NOTE: caller must protect get_condition calls by locking DC_mutex */ static OP *get_condition(pTHX) { SV **pc = hv_fetch(Pending_conditionals, get_key(PL_op), KEY_SZ, 0); if (pc && SvROK(*pc)) { dSP; NDEB(D(L, "get_condition from %p, %p: %p (%s)\n", PL_op, (void *)PL_op->op_targ, pc, hex_key(get_key(PL_op)))); /* dump_conditions(aTHX); */ NDEB(svdump(Pending_conditionals)); add_condition(aTHX_ *pc, SvTRUE(TOPs) ? 2 : 1); } else { PDEB(D(L, "All is lost, I know not where to go from %p, %p: %p (%s)\n", PL_op, (void *)PL_op->op_targ, pc, hex_key(get_key(PL_op)))); dump_conditions(aTHX); NDEB(svdump(Pending_conditionals)); /* croak("urgh"); */ exit(1); } return PL_op; } static void finalise_conditions(pTHX) { /* * Our algorithm for conditions relies on ending up at a particular * op which we use to call get_condition(). It's possible that we * never get to that op; for example we might return out of a sub. * This causes us to lose coverage information. * * This function is called after the program has been run in order * to collect that lost information. */ HE *e; NDEB(D(L, "finalise_conditions\n")); /* dump_conditions(aTHX); */ NDEB(svdump(Pending_conditionals)); MUTEX_LOCK(&DC_mutex); hv_iterinit(Pending_conditionals); while ((e = hv_iternext(Pending_conditionals))) { add_condition(aTHX_ hv_iterval(Pending_conditionals, e), 0); } MUTEX_UNLOCK(&DC_mutex); } static void cover_cond(pTHX) { dMY_CXT; if (collecting(Branch)) { dSP; int val = SvTRUE(TOPs); add_branch(aTHX_ PL_op, !val); } } static void cover_logop(pTHX) { /* * For OP_AND, if the first operand is false, we have short * circuited the second, otherwise the value of the and op is the * value of the second operand. * * For OP_OR, if the first operand is true, we have short circuited * the second, otherwise the value of the and op is the value of the * second operand. * * We check the value of the first operand by simply looking on the * stack. To check the second operand it is necessary to note the * location of the next op after this logop. When we get there, we * look at the stack and store the coverage information indexed to * this op. * * This scheme also works for OP_XOR with a small modification * because it doesn't short circuit. See the comment below. * * To find out when we get to the next op we change the op_ppaddr to * point to get_condition(), which will do the necessary work and * then reset and run the original op_ppaddr. We also store * information in the Pending_conditionals hash. This is keyed on * the op and the value is an array, the first element of which is * the op we are messing with, the second element of which is the * op_ppaddr we overwrote, and the subsequent elements are the ops * about which we are collecting the condition coverage information. * Note that an op may be collecting condition coverage information * about a number of conditions. */ dMY_CXT; NDEB(D(L, "logop() at %p\n", PL_op)); NDEB(op_dump(PL_op)); if (!collecting(Condition)) return; if (cLOGOP->op_first->op_type == OP_ITER) { /* loop - ignore it for now*/ } else { dSP; int left_val = SvTRUE(TOPs); #if PERL_VERSION > 8 int left_val_def = SvOK(TOPs); #endif /* We don't count X= as void context because we care about the value * of the RHS. */ int void_context = GIMME_V == G_VOID && #if PERL_VERSION > 8 PL_op->op_type != OP_DORASSIGN && #endif PL_op->op_type != OP_ANDASSIGN && PL_op->op_type != OP_ORASSIGN; NDEB(D(L, "left_val: %d, void_context: %d at %p\n", left_val, void_context, PL_op)); NDEB(op_dump(PL_op)); set_conditional(aTHX_ PL_op, 5, void_context); if ((PL_op->op_type == OP_AND && left_val) || (PL_op->op_type == OP_ANDASSIGN && left_val) || (PL_op->op_type == OP_OR && !left_val) || (PL_op->op_type == OP_ORASSIGN && !left_val) || #if PERL_VERSION > 8 (PL_op->op_type == OP_DOR && !left_val_def) || (PL_op->op_type == OP_DORASSIGN && !left_val_def) || #endif (PL_op->op_type == OP_XOR)) { /* no short circuit */ OP *right = cLOGOP->op_first->op_sibling; NDEB(op_dump(right)); if (void_context || right->op_type == OP_NEXT || right->op_type == OP_LAST || right->op_type == OP_REDO || right->op_type == OP_GOTO || right->op_type == OP_RETURN || right->op_type == OP_DIE) { /* * If we are in void context, or the right side of the op is a * branch, we don't care what its value is - it won't be * returning one. We're just glad to be here, so we chalk up * success. */ NDEB(D(L, "Add conditional 2\n")); add_conditional(aTHX_ PL_op, 2); } else { char *ch; AV *conds; SV **cref, *cond; OP *next; if (PL_op->op_type == OP_XOR && left_val) { /* * This is an xor. It does not short circuit. We * have just executed the first op. When we get to * next we will have already done the xor, so we can * work out what the value of the second op was. * * We set a flag in the first element of the array * to say that we had a true value from the first * op. */ set_conditional(aTHX_ PL_op, 0, 1); } #if PERL_VERSION > 14 NDEB(D(L, "Getting next\n")); next = (PL_op->op_type == OP_XOR) ? PL_op->op_next : right->op_next; #else next = PL_op->op_next; #endif if (PL_op->op_type == OP_XOR && !next) return; /* in fold_constants */ NDEB(op_dump(PL_op)); NDEB(op_dump(next)); ch = get_key(next); MUTEX_LOCK(&DC_mutex); cref = hv_fetch(Pending_conditionals, ch, KEY_SZ, 1); if (SvROK(*cref)) conds = (AV *)SvRV(*cref); else *cref = newRV_inc((SV*) (conds = newAV())); if (av_len(conds) < 0) { av_push(conds, newSViv(PTR2IV(next))); av_push(conds, newSViv(PTR2IV(next->op_ppaddr))); } #ifdef USE_ITHREADS conds = get_conds(aTHX_ conds); #endif cond = newSViv(PTR2IV(PL_op)); av_push(conds, cond); NDEB(D(L, "Adding conditional %p (%s) " "making %d at %p (%s), ppaddr: %p\n", next, PL_op_name[next->op_targ], av_len(conds) - 1, PL_op, hex_key(ch), next->op_ppaddr)); /* dump_conditions(aTHX); */ NDEB(svdump(Pending_conditionals)); NDEB(op_dump(PL_op)); NDEB(op_dump(next)); next->op_ppaddr = get_condition; MUTEX_UNLOCK(&DC_mutex); } } else { /* short circuit */ #if PERL_VERSION > 14 OP *up = cLOGOP->op_first->op_sibling->op_next; while (up->op_type == PL_op->op_type) { NDEB(D(L, "Considering adding %p (%s) -> (%p) " "from %p (%s) -> (%p)\n", up, PL_op_name[up->op_type], up->op_next, PL_op, PL_op_name[PL_op->op_type], PL_op->op_next)); add_conditional(aTHX_ up, 3); if (up->op_next == PL_op->op_next) break; up = cLOGOPx(up)->op_first->op_sibling->op_next; } #endif add_conditional(aTHX_ PL_op, 3); } } } static OP *dc_nextstate(pTHX) { dMY_CXT; NDEB(D(L, "dc_nextstate() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering) check_if_collecting(aTHX_ cCOP); if (collecting_here(aTHX)) cover_current_statement(aTHX); return MY_CXT.ppaddr[OP_NEXTSTATE](aTHX); } #if PERL_VERSION <= 10 static OP *dc_setstate(pTHX) { dMY_CXT; NDEB(D(L, "dc_setstate() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering) check_if_collecting(aTHX_ cCOP); if (collecting_here(aTHX)) cover_current_statement(aTHX); return MY_CXT.ppaddr[OP_SETSTATE](aTHX); } #endif static OP *dc_dbstate(pTHX) { dMY_CXT; NDEB(D(L, "dc_dbstate() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering) check_if_collecting(aTHX_ cCOP); if (collecting_here(aTHX)) cover_current_statement(aTHX); return MY_CXT.ppaddr[OP_DBSTATE](aTHX); } static OP *dc_entersub(pTHX) { dMY_CXT; NDEB(D(L, "dc_entersub() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering) store_return(aTHX); return MY_CXT.ppaddr[OP_ENTERSUB](aTHX); } static OP *dc_cond_expr(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_cond_expr() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_cond(aTHX); return MY_CXT.ppaddr[OP_COND_EXPR](aTHX); } static OP *dc_and(pTHX) { dMY_CXT; NDEB(D(L, "dc_and() at %p (%d)\n", PL_op, collecting_here(aTHX))); check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_and() at %p (%d)\n", PL_curcop, collecting_here(aTHX))); NDEB(D(L, "PL_curcop: %s:%d\n", CopFILE(PL_curcop), CopLINE(PL_curcop))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_AND](aTHX); } static OP *dc_andassign(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_andassign() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_ANDASSIGN](aTHX); } static OP *dc_or(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_or() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_OR](aTHX); } static OP *dc_orassign(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_orassign() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_ORASSIGN](aTHX); } #if PERL_VERSION > 8 static OP *dc_dor(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_dor() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_DOR](aTHX); } static OP *dc_dorassign(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_dorassign() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_DORASSIGN](aTHX); } #endif OP *dc_xor(pTHX) { dMY_CXT; check_if_collecting(aTHX_ PL_curcop); NDEB(D(L, "dc_xor() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX); return MY_CXT.ppaddr[OP_XOR](aTHX); } static OP *dc_require(pTHX) { dMY_CXT; NDEB(D(L, "dc_require() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) store_module(aTHX); return MY_CXT.ppaddr[OP_REQUIRE](aTHX); } static OP *dc_exec(pTHX) { dMY_CXT; NDEB(D(L, "dc_exec() at %p (%d)\n", PL_op, collecting_here(aTHX))); if (MY_CXT.covering && collecting_here(aTHX)) call_report(aTHX); return MY_CXT.ppaddr[OP_EXEC](aTHX); } static void replace_ops (pTHX) { dMY_CXT; int i; NDEB(D(L, "initialising replace_ops\n")); for (i = 0; i < MAXO; i++) MY_CXT.ppaddr[i] = PL_ppaddr[i]; PL_ppaddr[OP_NEXTSTATE] = dc_nextstate; #if PERL_VERSION <= 10 PL_ppaddr[OP_SETSTATE] = dc_setstate; #endif PL_ppaddr[OP_DBSTATE] = dc_dbstate; PL_ppaddr[OP_ENTERSUB] = dc_entersub; PL_ppaddr[OP_COND_EXPR] = dc_cond_expr; PL_ppaddr[OP_AND] = dc_and; PL_ppaddr[OP_ANDASSIGN] = dc_andassign; PL_ppaddr[OP_OR] = dc_or; PL_ppaddr[OP_ORASSIGN] = dc_orassign; #if PERL_VERSION > 8 PL_ppaddr[OP_DOR] = dc_dor; PL_ppaddr[OP_DORASSIGN] = dc_dorassign; #endif PL_ppaddr[OP_XOR] = dc_xor; PL_ppaddr[OP_REQUIRE] = dc_require; PL_ppaddr[OP_EXEC] = dc_exec; } static void initialise(pTHX) { dMY_CXT; NDEB(D(L, "initialising\n")); MUTEX_LOCK(&DC_mutex); if (!Pending_conditionals) { Pending_conditionals = newHV(); #ifdef USE_ITHREADS HvSHAREKEYS_off(Pending_conditionals); #endif } if (!Return_ops) { Return_ops = newHV(); #ifdef USE_ITHREADS HvSHAREKEYS_off(Return_ops); #endif } MUTEX_UNLOCK(&DC_mutex); MY_CXT.collecting_here = 1; if (!MY_CXT.covering) { /* TODO - this probably leaks all over the place */ SV **tmp; MY_CXT.cover = newHV(); #ifdef USE_ITHREADS HvSHAREKEYS_off(MY_CXT.cover); #endif tmp = hv_fetch(MY_CXT.cover, "statement", 9, 1); MY_CXT.statements = newHV(); *tmp = newRV_inc((SV*) MY_CXT.statements); tmp = hv_fetch(MY_CXT.cover, "branch", 6, 1); MY_CXT.branches = newHV(); *tmp = newRV_inc((SV*) MY_CXT.branches); tmp = hv_fetch(MY_CXT.cover, "condition", 9, 1); MY_CXT.conditions = newHV(); *tmp = newRV_inc((SV*) MY_CXT.conditions); #if CAN_PROFILE tmp = hv_fetch(MY_CXT.cover, "time", 4, 1); MY_CXT.times = newHV(); *tmp = newRV_inc((SV*) MY_CXT.times); #endif tmp = hv_fetch(MY_CXT.cover, "module", 6, 1); MY_CXT.modules = newHV(); *tmp = newRV_inc((SV*) MY_CXT.modules); MY_CXT.files = get_hv("Devel::Cover::Files", FALSE); #ifdef USE_ITHREADS HvSHAREKEYS_off(MY_CXT.statements); HvSHAREKEYS_off(MY_CXT.branches); HvSHAREKEYS_off(MY_CXT.conditions); #if CAN_PROFILE HvSHAREKEYS_off(MY_CXT.times); #endif HvSHAREKEYS_off(MY_CXT.modules); #endif MY_CXT.profiling_key_valid = 0; MY_CXT.module = newSVpv("", 0); MY_CXT.lastfile = newSVpvn("", 1); MY_CXT.covering = All; MY_CXT.tid = tid++; MY_CXT.replace_ops = SvTRUE(get_sv("Devel::Cover::Replace_ops", FALSE)); NDEB(D(L, "running with Replace_ops as %d\n", MY_CXT.replace_ops)); } } static int runops_cover(pTHX) { dMY_CXT; NDEB(D(L, "entering runops_cover\n")); #if defined HAS_GETTIMEOFDAY elapsed(); #elif defined HAS_TIMES cpu(); #endif for (;;) { NDEB(D(L, "running func %p from %p (%s)\n", PL_op->op_ppaddr, PL_op, OP_NAME(PL_op))); if (!MY_CXT.covering) goto call_fptr; /* Nothing to collect when we've hijacked the ppaddr */ { int hijacked; MUTEX_LOCK(&DC_mutex); hijacked = PL_op->op_ppaddr == get_condition; MUTEX_UNLOCK(&DC_mutex); if (hijacked) goto call_fptr; } /* Check to see whether we are interested in this file */ if (PL_op->op_type == OP_NEXTSTATE) { check_if_collecting(aTHX_ cCOP); } else if (PL_op->op_type == OP_ENTERSUB) { store_return(aTHX); } if (!collecting_here(aTHX)) goto call_fptr; /* * We are about the run the op PL_op, so we'll collect * information for it now. */ switch (PL_op->op_type) { case OP_NEXTSTATE: #if PERL_VERSION <= 10 case OP_SETSTATE: #endif case OP_DBSTATE: { cover_current_statement(aTHX); break; } case OP_COND_EXPR: { cover_cond(aTHX); break; } case OP_AND: case OP_ANDASSIGN: case OP_OR: case OP_ORASSIGN: #if PERL_VERSION > 8 case OP_DOR: case OP_DORASSIGN: #endif case OP_XOR: { cover_logop(aTHX); break; } case OP_REQUIRE: { store_module(aTHX); break; } case OP_EXEC: { call_report(aTHX); break; } default: ; /* IBM's xlC compiler on AIX is very picky */ } call_fptr: if (!(PL_op = PL_op->op_ppaddr(aTHX))) break; PERL_ASYNC_CHECK(); } #if CAN_PROFILE cover_time(aTHX); #endif MY_CXT.collecting_here = 1; NDEB(D(L, "exiting runops_cover\n")); TAINT_NOT; return 0; } static int runops_orig(pTHX) { NDEB(D(L, "entering runops_orig\n")); while ((PL_op = PL_op->op_ppaddr(aTHX))) { PERL_ASYNC_CHECK(); } NDEB(D(L, "exiting runops_orig\n")); TAINT_NOT; return 0; } static int runops_trace(pTHX) { PDEB(D(L, "entering runops_trace\n")); for (;;) { PDEB(D(L, "running func %p from %p (%s)\n", PL_op->op_ppaddr, PL_op, OP_NAME(PL_op))); if (!(PL_op = PL_op->op_ppaddr(aTHX))) break; PERL_ASYNC_CHECK(); } PDEB(D(L, "exiting runops_trace\n")); TAINT_NOT; return 0; } static char *svclassnames[] = { "B::NULL", "B::IV", "B::NV", "B::RV", "B::PV", "B::PVIV", "B::PVNV", "B::PVMG", "B::BM", "B::GV", "B::PVLV", "B::AV", "B::HV", "B::CV", "B::FM", "B::IO", }; static SV *make_sv_object(pTHX_ SV *arg, SV *sv) { IV iv; char *type; iv = PTR2IV(sv); type = svclassnames[SvTYPE(sv)]; sv_setiv(newSVrv(arg, type), iv); return arg; } typedef OP *B__OP; typedef AV *B__AV; MODULE = Devel::Cover PACKAGE = Devel::Cover PROTOTYPES: ENABLE void set_criteria(flag) unsigned flag PREINIT: dMY_CXT; PPCODE: MY_CXT.covering = flag; /* fprintf(stderr, "Cover set to %d\n", flag); */ if (MY_CXT.replace_ops) { return; } PL_runops = MY_CXT.covering ? runops_cover : runops_orig; void add_criteria(flag) unsigned flag PREINIT: dMY_CXT; PPCODE: MY_CXT.covering |= flag; if (MY_CXT.replace_ops) { return; } PL_runops = MY_CXT.covering ? runops_cover : runops_orig; void remove_criteria(flag) unsigned flag PREINIT: dMY_CXT; PPCODE: MY_CXT.covering &= ~flag; if (MY_CXT.replace_ops) { return; } PL_runops = MY_CXT.covering ? runops_cover : runops_orig; unsigned get_criteria() PREINIT: dMY_CXT; CODE: RETVAL = MY_CXT.covering; OUTPUT: RETVAL unsigned coverage_none() CODE: RETVAL = None; OUTPUT: RETVAL unsigned coverage_statement() CODE: RETVAL = Statement; OUTPUT: RETVAL unsigned coverage_branch() CODE: RETVAL = Branch; OUTPUT: RETVAL unsigned coverage_condition() CODE: RETVAL = Condition; OUTPUT: RETVAL unsigned coverage_subroutine() CODE: RETVAL = Subroutine; OUTPUT: RETVAL unsigned coverage_path() CODE: RETVAL = Path; OUTPUT: RETVAL unsigned coverage_pod() CODE: RETVAL = Pod; OUTPUT: RETVAL unsigned coverage_time() CODE: RETVAL = Time; OUTPUT: RETVAL unsigned coverage_all() CODE: RETVAL = All; OUTPUT: RETVAL double get_elapsed() CODE: #ifdef HAS_GETTIMEOFDAY RETVAL = get_elapsed(); #else RETVAL = 0; #endif OUTPUT: RETVAL SV * coverage(final) unsigned final PREINIT: dMY_CXT; CODE: NDEB(D(L, "Getting coverage %d\n", final)); if (final) finalise_conditions(aTHX); if (MY_CXT.cover) RETVAL = newRV_inc((SV*) MY_CXT.cover); else RETVAL = &PL_sv_undef; OUTPUT: RETVAL SV * get_key(o) B::OP o CODE: RETVAL = newSV(KEY_SZ + 1); sv_setpvn(RETVAL, get_key(o), KEY_SZ); OUTPUT: RETVAL void set_first_init_and_end() PPCODE: set_firsts_if_needed(aTHX); void collect_inits() PREINIT: dMY_CXT; PPCODE: int i; NDEB(svdump(end)); if (!MY_CXT.ends) MY_CXT.ends = newAV(); if (PL_initav) for (i = 0; i <= av_len(PL_initav); i++) { SV **cv = av_fetch(PL_initav, i, 0); SvREFCNT_inc(*cv); av_push(MY_CXT.ends, *cv); } void set_last_end() PREINIT: dMY_CXT; PPCODE: int i; SV *end = (SV *)get_cv("last_end", 0); av_push(PL_endav, end); NDEB(svdump(end)); if (!MY_CXT.ends) MY_CXT.ends = newAV(); if (PL_endav) for (i = 0; i <= av_len(PL_endav); i++) { SV **cv = av_fetch(PL_endav, i, 0); SvREFCNT_inc(*cv); av_push(MY_CXT.ends, *cv); } B::AV get_ends() PREINIT: dMY_CXT; CODE: if (!MY_CXT.ends) MY_CXT.ends = newAV(); /* TODO: how? */ RETVAL = MY_CXT.ends; OUTPUT: RETVAL BOOT: { MY_CXT_INIT; #ifdef USE_ITHREADS MUTEX_INIT(&DC_mutex); #endif initialise(aTHX); if (MY_CXT.replace_ops) { replace_ops(aTHX); #if defined HAS_GETTIMEOFDAY elapsed(); #elif defined HAS_TIMES cpu(); #endif /* PL_runops = runops_trace; */ } else { PL_runops = runops_cover; } #if PERL_VERSION > 6 PL_savebegin = TRUE; #endif } tests000755001750001750 012206216060 13672 5ustar00pjcjpjcj000000000000Devel-Cover-1.08t2100644001750001750 73212206216060 14264 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; my @x; sub xx { $x[shift]++; } for (0 .. 10) { time && $x[1]++; $x[2]++ if time; for (0 .. 2) { $x[3]++; } if (time) { xx(4); } else { $x[5]++; } } t0100644001750001750 101312206216060 14273 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; my @x; my $y = 1; for (0 .. 10) { $y && $x[1]++; $y && $x[0]++ && $x[1]++; $x[2]++ if $y; for (0 .. 2) { $x[3]++; } if ($y) { $x[4]++; } else { $x[5]++; } } # print join(", ", @x), "\n"; if100644001750001750 70612206216060 14336 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; my ($x, $p, $q, $r, $s); $x = 0; if ($x) { $p++ } unless ($x) { $q++ } $x = 1; if ($x) { $r++ } if ($x) { $r++ } else { $s++ } unless ($x) { $s++ } t1100644001750001750 47512206216060 14267 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; my @x; sub xx { $x[shift]++; } xx(4); utils000755001750001750 012206216060 13670 5ustar00pjcjpjcj000000000000Devel-Cover-1.08dc100755001750001750 63012206216060 14323 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/utils#!/usr/bin/zsh case "$1" in "update-copyright") from="${2:-`date +'%Y' --date='last year'`}" to="${3:-`date +'%Y'`}" echo Updating copyright from $from to $to perl -pi -e "s/Copyright \d+-\K$from(, Paul Johnson)/$to\$1/" **/*(.) perl -pi -e "s/Copyright $from\K(, Paul Johnson)/-$to\$1/" **/*(.) ;; *) echo Unknown option "$1" ;; esac META.yml100644001750001750 1136012206216060 14162 0ustar00pjcjpjcj000000000000Devel-Cover-1.08--- abstract: 'Code coverage metrics for Perl' author: - 'Paul Johnson ' build_requires: Test::More: 0 Test::Warn: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300034, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Devel-Cover no_index: directory: - tests - t - utils recommends: Browser::Open: 0 JSON::PP: 0 PPI::HTML: 1.07 Parallel::Iterator: 0 Perl::Tidy: 20060719 Pod::Coverage: 0.06 Pod::Coverage::CountParents: 0 Template: 2.00 Test::Differences: 0 perl: 5.008002 requires: Digest::MD5: 0 Storable: 0 perl: 5.006001 resources: X_mailing_list: http://lists.perl.org/list/perl-qa.html bugtracker: https://github.com/pjcj/Devel--Cover/issues homepage: http://www.pjcj.net/perl.html license: http://dev.perl.org/licenses repository: http://github.com/pjcj/Devel--Cover version: 1.08 x_Dist_Zilla: perl: version: 5.018000 plugins: - class: Dist::Zilla::Plugin::VersionFromScript name: VersionFromScript version: 0.017 - class: Dist::Zilla::Plugin::Run::BeforeBuild name: Run::BeforeBuild version: 0.020 - class: Dist::Zilla::Plugin::GatherDir name: GatherDir version: 4.300034 - class: Dist::Zilla::Plugin::ManifestSkip name: ManifestSkip version: 4.300034 - class: Dist::Zilla::Plugin::ExecDir name: ExecDir version: 4.300034 - class: Dist::Zilla::Plugin::OurPkgVersion name: OurPkgVersion version: 0.004000 - class: Dist::Zilla::Plugin::PodVersion name: PodVersion version: 4.300034 - class: Dist::Zilla::Plugin::MetaYAML name: MetaYAML version: 4.300034 - class: Dist::Zilla::Plugin::MetaJSON name: MetaJSON version: 4.300034 - class: Dist::Zilla::Plugin::MetaConfig name: MetaConfig version: 4.300034 - class: Dist::Zilla::Plugin::MetaResources name: MetaResources version: 4.300034 - class: Dist::Zilla::Plugin::MetaNoIndex name: MetaNoIndex version: 4.300034 - class: Dist::Zilla::Plugin::Manifest name: Manifest version: 4.300034 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: 4.300034 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: recommends name: Recommends version: 4.300034 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: configure type: requires name: ConfigureRequires version: 4.300034 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: TestRequires version: 4.300034 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: recommends name: TestRecommends version: 4.300034 - class: Dist::Zilla::Plugin::Run::Test name: Run::Test version: 0.020 - class: Dist::Zilla::Plugin::Git::Check name: Git::Check version: 2.013 - class: Dist::Zilla::Plugin::NextRelease name: NextRelease version: 4.300034 - class: Dist::Zilla::Plugin::Git::Commit name: Git::Commit version: 2.013 - class: Dist::Zilla::Plugin::Git::Tag name: Git::Tag version: 2.013 - class: Dist::Zilla::Plugin::TestRelease name: TestRelease version: 4.300034 - class: Dist::Zilla::Plugin::ConfirmRelease name: ConfirmRelease version: 4.300034 - class: Dist::Zilla::Plugin::UploadToCPAN name: UploadToCPAN version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: 4.300034 zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: 4.300034 MANIFEST100644001750001750 1723712206216060 14053 0ustar00pjcjpjcj000000000000Devel-Cover-1.08.gitignore .travis.yml Changes Cover.xs MANIFEST MANIFEST.SKIP META.json META.yml Makefile.PL README bin/cover bin/cpancover bin/gcov2perl dist.ini docs/BUGS docs/RELEASE docs/TODO lib/Devel/Cover.pm lib/Devel/Cover/Annotation/Git.pm lib/Devel/Cover/Annotation/Random.pm lib/Devel/Cover/Annotation/Svk.pm lib/Devel/Cover/Branch.pm lib/Devel/Cover/Condition.pm lib/Devel/Cover/Condition_and_2.pm lib/Devel/Cover/Condition_and_3.pm lib/Devel/Cover/Condition_or_2.pm lib/Devel/Cover/Condition_or_3.pm lib/Devel/Cover/Condition_xor_4.pm lib/Devel/Cover/Criterion.pm lib/Devel/Cover/DB.pm lib/Devel/Cover/DB/Digests.pm lib/Devel/Cover/DB/File.pm lib/Devel/Cover/DB/IO.pm lib/Devel/Cover/DB/IO/JSON.pm lib/Devel/Cover/DB/IO/Storable.pm lib/Devel/Cover/DB/Structure.pm lib/Devel/Cover/Dumper.pm lib/Devel/Cover/Html_Common.pm lib/Devel/Cover/Op.pm lib/Devel/Cover/Pod.pm lib/Devel/Cover/Report/Compilation.pm lib/Devel/Cover/Report/Html.pm lib/Devel/Cover/Report/Html_basic.pm lib/Devel/Cover/Report/Html_minimal.pm lib/Devel/Cover/Report/Html_subtle.pm lib/Devel/Cover/Report/Sort.pm lib/Devel/Cover/Report/Text.pm lib/Devel/Cover/Report/Text2.pm lib/Devel/Cover/Report/Vim.pm lib/Devel/Cover/Statement.pm lib/Devel/Cover/Subroutine.pm lib/Devel/Cover/Test.pm lib/Devel/Cover/Time.pm lib/Devel/Cover/Truth_Table.pm lib/Devel/Cover/Tutorial.pod lib/Devel/Cover/Util.pm lib/Devel/Cover/Web.pm t/internal/criteria.t t/internal/inc_filter.t t/internal/inc_filter/cwd/lib/.dummy t/internal/inc_filter/cwd_lib/.dummy t/internal/launch.t t/internal/subprocess.t t/regexp/regexp_eval.t test_output/cover/accessor.5.006001 test_output/cover/accessor.5.008 test_output/cover/alias.5.006001 test_output/cover/alias1.5.006001 test_output/cover/alias1.5.008 test_output/cover/bigint.5.006001 test_output/cover/bigint.5.008 test_output/cover/bigint.5.008001 test_output/cover/branch_return_sub.5.006001 test_output/cover/branch_return_sub.5.008 test_output/cover/bug_and.5.006001 test_output/cover/bug_and.5.008 test_output/cover/bug_and.5.008001 test_output/cover/bug_and.5.012000 test_output/cover/bug_and.5.016000 test_output/cover/change.5.006001 test_output/cover/cond_and.5.006001 test_output/cover/cond_and.5.008 test_output/cover/cond_and.5.008001 test_output/cover/cond_branch.5.006001 test_output/cover/cond_branch.5.008 test_output/cover/cond_branch.5.008001 test_output/cover/cond_branch.5.012000 test_output/cover/cond_branch.5.014000 test_output/cover/cond_branch.5.016000 test_output/cover/cond_branch.5.017003 test_output/cover/cond_chained.5.006001 test_output/cover/cond_chained.5.008001 test_output/cover/cond_chained.5.016000 test_output/cover/cond_or.5.008 test_output/cover/cond_or.5.008001 test_output/cover/cond_or.5.010000 test_output/cover/cond_xor.5.006001 test_output/cover/cond_xor.5.008 test_output/cover/cond_xor.5.008001 test_output/cover/cop.5.006001 test_output/cover/cop.5.008 test_output/cover/dbm_cond.5.008005 test_output/cover/default_param.5.006001 test_output/cover/default_param.5.008 test_output/cover/default_param.5.008001 test_output/cover/default_param.5.014000 test_output/cover/deparse.5.006001 test_output/cover/deparse.5.008 test_output/cover/destroy.5.006001 test_output/cover/dynamic_subs.5.006001 test_output/cover/dynamic_subs.5.008 test_output/cover/dynamic_subs.5.008001 test_output/cover/dynamic_subs.5.008002 test_output/cover/eval1.5.006001 test_output/cover/eval1.5.008 test_output/cover/eval2.5.006001 test_output/cover/eval2.5.008 test_output/cover/eval3.5.006001 test_output/cover/eval3.5.008 test_output/cover/eval_nested.5.006001 test_output/cover/eval_nested.5.008 test_output/cover/eval_sub.t.5.006001 test_output/cover/eval_sub.t.5.008 test_output/cover/eval_use.t.5.006001 test_output/cover/eval_use.t.5.008 test_output/cover/exec.5.006001 test_output/cover/exec_die.5.006001 test_output/cover/fork.5.006001 test_output/cover/if.5.006001 test_output/cover/if.5.008 test_output/cover/inc_sub.5.006001 test_output/cover/inc_sub.5.008 test_output/cover/inc_sub.5.010000 test_output/cover/inc_sub.5.010001 test_output/cover/inc_sub.5.012000 test_output/cover/inc_sub.5.012001 test_output/cover/inc_sub.5.012003 test_output/cover/inc_sub.5.012005 test_output/cover/md5.5.006001 test_output/cover/module1.5.006001 test_output/cover/module1.5.008 test_output/cover/module1.5.008001 test_output/cover/module2.5.006001 test_output/cover/module2.5.008 test_output/cover/module2.5.008001 test_output/cover/module_ignore.5.006001 test_output/cover/module_ignore.5.008 test_output/cover/module_ignore.5.008001 test_output/cover/module_import.5.006001 test_output/cover/module_import.5.008 test_output/cover/module_import.5.008001 test_output/cover/module_relative.5.008 test_output/cover/module_relative.5.008001 test_output/cover/moo_cond.5.008002 test_output/cover/moose_basic.5.010000 test_output/cover/moose_cond.5.010000 test_output/cover/moose_constraint.5.010000 test_output/cover/moose_constraint.5.016000 test_output/cover/overload_bool.5.006001 test_output/cover/overload_bool.5.008 test_output/cover/overloaded.5.006001 test_output/cover/overloaded.5.008 test_output/cover/padrange.5.006001 test_output/cover/padrange.5.008 test_output/cover/padrange.5.008001 test_output/cover/pod.5.006001 test_output/cover/pod.5.008 test_output/cover/pod_nocp.5.006001 test_output/cover/pod_nocp.5.008 test_output/cover/readonly.5.008002 test_output/cover/redefine_sub.5.006001 test_output/cover/require.5.006001 test_output/cover/require.5.008 test_output/cover/skip.5.006001 test_output/cover/sort.5.006001 test_output/cover/sort.5.008 test_output/cover/special_blocks.5.006001 test_output/cover/special_blocks.5.008 test_output/cover/special_blocks.5.008001 test_output/cover/special_blocks.5.010000 test_output/cover/statement.5.006001 test_output/cover/subs_only.5.006001 test_output/cover/t0.5.006001 test_output/cover/t0.5.008 test_output/cover/t0.5.008001 test_output/cover/t1.5.006001 test_output/cover/t1.5.008 test_output/cover/t2.5.006001 test_output/cover/t2.5.008 test_output/cover/t2.5.008001 test_output/cover/taint.5.006001 test_output/cover/taint.5.008 test_output/cover/trivial.5.006001 test_output/cover/uncoverable.5.006001 test_output/cover/xor_constant_fold.5.006001 tests/.uncoverable tests/Accessor_maker.pm tests/Alias1.pm tests/COP.pm tests/E2.pm tests/E3.pm tests/E4.pm tests/IncSub.pm tests/Module1.pm tests/Module2.pm tests/Module_import.pm tests/PodMod.pm tests/Taint.pm tests/accessor tests/alias tests/alias1 tests/bigint tests/branch_return_sub tests/bug_and tests/change.t tests/cond_and tests/cond_branch tests/cond_chained tests/cond_or tests/cond_or.pl tests/cond_xor tests/cop tests/dbm_cond tests/default_param tests/deparse tests/destroy tests/dist/DC-Test-Dist/Makefile.PL tests/dist/DC-Test-Dist/lib/DC/Test/Dist.pm tests/dist/DC-Test-Dist/lib/DC/Test/Dist/M1.pm tests/dist/DC-Test-Dist/t/t1.t tests/dynamic_subs tests/eval1 tests/eval2 tests/eval3 tests/eval_nested tests/eval_sub.t tests/eval_use.t tests/exec tests/exec_die tests/fork tests/if tests/inc_sub tests/md5.t tests/module1 tests/module2 tests/module_ignore tests/module_import tests/module_relative tests/moo_cond tests/moose_basic tests/moose_cond tests/moose_constraint tests/overload_bool tests/overloaded tests/padrange tests/pod tests/pod_nocp tests/random/dir/file tests/readonly tests/redefine_sub tests/require tests/skip tests/sort tests/special_blocks tests/statement tests/subs_only tests/t0 tests/t1 tests/t2 tests/taint tests/trivial tests/uncoverable tests/xor_constant_fold utils/Devel/Cover/BuildUtils.pm utils/all_versions utils/bisect.sh utils/cpanmcover utils/create_all_gold utils/create_gold utils/dc utils/install/System.pm utils/install/buildperl utils/install_dev_modules utils/install_modules utils/makeh utils/run_cpancover utils/scanuncov utils/session.vim utils/typemap cop100644001750001750 52312206216060 14516 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2011-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; use lib "tests"; $SIG{__WARN__} = sub { die @_ }; require COP; pod100644001750001750 113712206216060 14541 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ criteria pod-also_private-xx # __COVER__ skip_test eval "use Pod::Coverage::CountParents"; $@ # __COVER__ skip_reason Pod::Coverage::CountParents unavailable use strict; use warnings; use lib "tests"; use PodMod; my @x; sub xx { $x[shift]++; Module1::zz(0); } for (0 .. 10) { if (time) { xx(0); } else { $x[1]++; } } docs000755001750001750 012206216060 13460 5ustar00pjcjpjcj000000000000Devel-Cover-1.08TODO100644001750001750 551312206216060 14314 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/docs- Enhancements: - Different criteria for different runs. - Marking of unreachable code - commandline tool and gui. - Threads support - at least for some coverage criteria. - Test analysis. - Profiling and speedups. - Collect data for path coverage. - Mutation coverage. - Regular Expression coverage. - Indicate how to increase coverage? - BEGIN and CHECK blocks and code in modules. Requires callbacks from perl? - Create a base class for Devel::Cover::Branch and Devel::Cover::Condition. - Handle C< $y || "${p}qqq" >. - 22:09 <@nothingmuch> return, redo, next, last, goto should probably all be treated as short circuiting - Add aliased subroutines to subroutine coverage. - Accommodate reloading modules at runtime (Mark Glines). - Don't count BEGIN blocks as subroutines. - Only collect boolean data for coverage information (no counts). - cpancover - Extend cpancover so people can upload databases. - Provide a view by author. - Make cpancover more general to be able to work on local modules. - Add verbosity option and set silent option from it. - Get Sort report working. - Reports: - Improve textual output. - Remove >= 100% in customisable thresholds. - Move HTML version and platform info to main page and allow for multiples. - Add -db option to cover. - Diff functionality. - Merge CSS from basic_html and cpancover. - Provide a way to control syntax colouring. - Cyclomatic complexity annotation. - Bugs: - Work with memoize. Is this still a problem? - See if the XS code leaks, and fix it if it does. - Look at time coverage again - collecting for too many ops? - Sort out time coverage on Windows. - Check for core dumps with pod coverage. - Fix "ignored" errors - see IO::Pager. - cpancover on CPAN: - PerlIO-eol-0.13 hangs. - CPAN@1432 hangs with bleadperl@29642. - cover -delete uses too much memory when cover_db doesn't exist. (clkao) - Games::Bingo broken. - Class::Unload only giving 50% coverage on return unless ... (losing data?) - JSON error in Archive::Extract and Test::LeakTrace. - cover -write new_db doesn't work (needs structure?). - Testing: - Be able to run Devel::Cover on itself. - More comprehensive. - Functional tests. - Overhaul test system. Include patt? - Tests for INIT and END blocks included in required files when the files are used in some runs. - Make sure dor is handled correctly and add more tests to cond_or. - Build: - Fix up make text and friends for module_ignore. - Check for matching threadedness, 64bits etc. between build and run? - Documentation: - General improvement. - Examples. - Cookbook including +/-inc, +/-ignore and +/-select. - Document cpancover options. - Pod in private modules. - Developer documentation. - Better DB API docs (including writing?). BUGS100644001750001750 156212206216060 14307 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/docs- BEGIN and CHECK blocks and code in modules is not reported. - Doesn't play nicely with all of Perl's testsuite. - elsif and else coverage is reported on the same line as the if statement. This is because perl doesn't store the line number for the elsif and elses. For the same reason the following warning is reported on line 1 rather than line 2: perl -we 'if ($a) {} elsif ($a + 1) {}' Use of uninitialized value in addition (+) at -e line 1. - Pod coverage only reports data for modules, not top level scripts. This is a limitation in Pod::Coverage. - Pod coverage does not work well with source filters including Switch. Line numbers are reported incorrectly. - If an END block installs another END block it won't be covered. More generally, any code run after Devel::Cover's END block won't be covered. - Empty subs will be ignored in Perl 5.8.1. bin000755001750001750 012206216060 13300 5ustar00pjcjpjcj000000000000Devel-Cover-1.08cover100644001750001750 4412512206216060 14527 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/bin#!/usr/bin/perl # Copyright 2001-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net require 5.6.1; use strict; use warnings; our $VERSION = '1.08'; # VERSION use Devel::Cover::DB; use Config; use File::Spec; use File::Find (); use File::Path; use Getopt::Long; use Pod::Usage; use Data::Dumper (); # no import of Dumper (use Devel::Cover::Dumper if needed) my $Options = { add_uncoverable_point => [], annotation => [], coverage => [], delete => undef, delete_uncoverable_point => [], gcov => $Config{gccversion}, ignore => [], ignore_re => [], launch => 0, make => $Config{make}, report => "", report_c0 => 75, report_c1 => 90, report_c2 => 100, select => [], select_re => [], summary => 1, uncoverable_file => [".uncoverable", glob("~/.uncoverable")], }; sub get_options { Getopt::Long::Configure("pass_through"); die "Bad option" unless GetOptions($Options, # Store the options in the Options hash. "write:s" => sub { @$Options{qw( write summary )} = ($_[1], 0) }, qw( add_uncoverable_point=s annotation=s clean_uncoverable_points! coverage=s delete! delete_uncoverable_point=s dump_db! gcov! help|h! ignore_re=s ignore=s info|i! launch! make=s outputdir=s report_c0=s report_c1=s report_c2=s report=s select_re=s select=s silent! summary! test! uncoverable_file=s version|v! )); Getopt::Long::Configure("nopass_through"); $Options->{report} ||= "html" unless exists $Options->{write}; # handle comma seperated ops, like -coverage branch,statement @{$Options->{coverage}} = split(/,/, join(",", @{$Options->{coverage}})); # also accept them in the same format they're output my %coverage_abbrev = ( stmt => 'statement', bran => 'branch', cond => 'condition', sub => 'subroutine', ); my %options_coverage = map {$_ => 1} @{$Options->{coverage}}; while (my ($abbr, $full) = each %coverage_abbrev) { $options_coverage{$full} = delete $options_coverage{$abbr} if $options_coverage{$abbr}; } @{$Options->{coverage}} = keys %options_coverage; # generating data may take time, so bail now if options are wrong my %coverage_allowed = map {$_ => 1} values %coverage_abbrev, "time", "pod"; for my $cov (@{$Options->{coverage}}) { die "Unrecognised -coverage: $cov" unless $coverage_allowed{$cov}; } } sub delete_db { for my $del (@_) { my $db = Devel::Cover::DB->new(db => $del); unless ($db->is_valid) { print "Devel::Cover: $del is an invalid database - ignoring\n" unless $Options->{silent}; next; } print "Deleting database $del\n" if $db->exists && !$Options->{silent}; $db->delete; rmtree($del); } } # Decide whether to run ./Build test or make test sub test_command { -e "Build" ? mb_test_command() : mm_test_command() } # Compiler arguments necessary to do a coverage run sub gcov_args() { "-fprofile-arcs -ftest-coverage" } # Test command for MakeMaker sub mm_test_command { my $test = "$Options->{make} test"; if ($Options->{gcov}) { my $o = gcov_args(); $test .= qq{ "OPTIMIZE=-O0 $o" "OTHERLDFLAGS=$o"}; } $test } # Test command for Module::Build sub mb_test_command { my $test = './Build test'; if ($Options->{gcov}) { my $o = gcov_args(); $test .= qq{ "--extra_compiler_flags=-O0 $o" "--extra_linker_flags=$o"}; } $test } sub main { if (!$ENV{DEVEL_COVER_SELF} && $INC{"Devel/Cover.pm"}) { my $err = "$0 shouldn't be run with coverage turned on.\n"; eval { require POSIX; print STDERR $err; POSIX::_exit(1); }; die $err; } get_options; $Devel::Cover::Silent = 1 if $Options->{silent}; my $format = "Devel::Cover::Report::\u$Options->{report}"; if (length $Options->{report}) { eval ("use $format"); if ($@) { print "Error: $Options->{report} ", "is not a recognised output format\n\n$@"; exit 1; } } $format->get_options($Options) if $format->can("get_options"); $Options->{annotations} = []; for my $a (@{$Options->{annotation}}) { my $annotation = "Devel::Cover::Annotation::\u$a"; eval ("use $annotation"); if ($@) { print "Error: $a is not a recognised annotation\n\n$@"; exit 1; } my $ann = $annotation->new; $ann->get_options($Options) if $ann->can("get_options"); push @{$Options->{annotations}}, $ann; } print "$0 version " . __PACKAGE__->VERSION . "\n" and exit 0 if $Options->{version}; pod2usage(-exitval => 0, -verbose => 1) if $Options->{help}; pod2usage(-exitval => 0, -verbose => 2) if $Options->{info}; my $dbname = File::Spec->rel2abs(@ARGV ? shift @ARGV : "cover_db"); die "Can't open database $dbname\n" if !$Options->{delete} && !$Options->{test} && !-d $dbname; $Options->{outputdir} = $dbname unless exists $Options->{outputdir}; my $od = File::Spec->rel2abs($Options->{outputdir}); $Options->{outputdir} = $od if defined $od; mkpath($Options->{outputdir}) unless -d $Options->{outputdir}; if ($Options->{delete}) { delete_db($dbname, @ARGV); exit 0 } my $test_result = 0; if ($Options->{test}) { # TODO - make this a little robust # system "$^X Makefile.PL" unless -e "Makefile"; delete_db($dbname, @ARGV) unless defined $Options->{delete}; my $env_db_name = $dbname; $env_db_name =~ s/\\/\\\\/g if $^O eq 'MSWin32'; my $extra = ""; $extra .= ",-coverage,$_" for @{$Options->{coverage}}; $extra .= ",-ignore,$_" for @{$Options->{ignore_re}}, map quotemeta glob, @{$Options->{ignore}}; $extra .= ",-select,$_" for @{$Options->{select_re}}, map quotemeta glob, @{$Options->{select}}; $Options->{$_} = [] for qw( ignore ignoring select select_re ); local $ENV{ -d "t" ? "HARNESS_PERL_SWITCHES" : "PERL5OPT" } = ($ENV{DEVEL_COVER_TEST_OPTS} || "") . " -MDevel::Cover=-db,$env_db_name$extra"; my $test = test_command(); # touch the XS, C and H files so they rebuild if ($Options->{gcov}) { my $t = $] > 5.7 ? undef : time; my $xs = sub { utime $t, $t, $_ if /\.(xs|cc?|hh?)$/ }; File::Find::find({ wanted => $xs, no_chdir => 0 }, "."); } # print STDERR "$_: $ENV{$_}\n" for qw(PERL5OPT HARNESS_PERL_SWITCHES); print STDERR "cover: running $test\n"; $test_result = system $test; $test_result >>= 8; $Options->{report} ||= "html"; } if ($Options->{gcov}) { my $gc = sub { return unless /\.(xs|cc?|hh?)$/; for my $re (@{$Options->{ignore_re}}) { return if /$re/; } my ($name) = /([^\/]+$)/; # Don't bother running gcov if there's no index files. # Otherwise it's noisy. my $graph_file = $_; $graph_file =~ s{\.\w+$}{.gcno}; return unless -e $graph_file; my @c = ("gcov", "-abc", "-o", $File::Find::dir, $name); print STDERR "cover: running @c\n"; system @c; }; File::Find::find({ wanted => $gc, no_chdir => 1 }, "."); my @gc; my $gp = sub { return unless /\.gcov$/; my $xs = $_; return if $xs =~ s/\.(cc?|hh?)\.gcov$/.xs.gcov/ && -e $xs; s/^\.\///; push @gc, $_; }; File::Find::find({ wanted => $gp, no_chdir => 1 }, "."); if (@gc) { # Find the right gcov2perl based on this current script. require Cwd; my $path = Cwd::abs_path($0); my ($vol, $dir, $cover) = File::Spec->splitpath($path); my $gcov2perl = File::Spec->catpath($vol, $dir, 'gcov2perl'); my @c = ($^X, $gcov2perl, "-db", $dbname, @gc); print STDERR "cover: running @c\n"; system @c; } } print "Reading database from $dbname\n" unless $Options->{silent}; my $db = Devel::Cover::DB->new ( db => $dbname, uncoverable_file => $Options->{uncoverable_file}, ); $db = $db->merge_runs; $db->add_uncoverable ($Options->{add_uncoverable_point} ); $db->delete_uncoverable ($Options->{delete_uncoverable_point}); $db->clean_uncoverable if $Options->{clean_uncoverable_points} ; exit $test_result if @{$Options->{add_uncoverable_point}} || @{$Options->{delete_uncoverable_point}} || $Options->{clean_uncoverable_points}; for my $merge (@ARGV) { print "Merging database from $merge\n" unless $Options->{silent}; my $mdb = Devel::Cover::DB->new(db => $merge); $mdb = $mdb->merge_runs; $db->merge($mdb); } if ($Options->{dump_db}) { my $d = Data::Dumper->new([$db], ["db"]); $d->Indent(1); $d->Sortkeys(1) if $] >= 5.008; print $d->Dump; my $structure = Devel::Cover::DB::Structure->new(base => $dbname); $structure->read_all; my $s = Data::Dumper->new([$structure], ["structure"]); $s->Indent(1); $s->Sortkeys(1) if $] >= 5.008; print $s->Dump; exit $test_result; } if (exists $Options->{write}) { $dbname = $Options->{write} if length $Options->{write}; print "Writing database to $dbname\n" unless $Options->{silent}; $db->write($dbname); } exit $test_result unless $Options->{summary} || $Options->{report}; $Options->{coverage} = [ $db->collected ] unless @{$Options->{coverage}}; $Options->{show} = { map { $_ => 1 } @{$Options->{coverage}} }; $Options->{show}{total} = 1 if keys %{$Options->{show}}; $db->calculate_summary(map { $_ => 1 } @{$Options->{coverage}}); print "\n\n" unless $Options->{silent}; # TODO - The sense of select and ignore should be reversed to match # collection. my %f = map { $_ => 1 } (@{$Options->{select}} ? map glob, @{$Options->{select}} : $db->cover->items); delete @f{map glob, @{$Options->{ignore}}}; my $keep = sub { my ($f) = @_; return 0 unless exists $db->{summary}{$_}; for (@{$Options->{ignore_re}}) { return 0 if $f =~ /$_/ } for (@{$Options->{select_re}}) { return 1 if $f =~ /$_/ } !@{$Options->{select_re}} }; @{$Options->{file}} = sort grep $keep->($_), keys %f; $db->print_summary($Options->{file}, $Options->{coverage}, {force => 1}) if $Options->{summary}; exit $test_result unless length $Options->{report}; $format->report($db, $Options); if ($Options->{launch}) { if ($format->can("launch")) { $format->launch($Options); } else { print STDERR "The launch option is not available for the ", "$Options->{report} report.\n" } } exit $test_result; } main __END__ =head1 NAME cover - report coverage statistics =head1 VERSION version 1.08 =head1 SYNOPSIS cover -help -info -version -summary -report report_format -outputdir dir -select filename -ignore filename -select_re RE -ignore_re RE -write [db] -delete -dump_db -launch -silent -coverage criterion -test -gcov -make [make] -add_uncoverable_point -delete_uncoverable_point -clean_uncoverable_points -uncoverable_file [report specific options] coverage_database [coverage_database ...] =head1 DESCRIPTION Report coverage statistics in a variety of formats. The summary option produces a short textual summary. Other reports are available by using the report option. The following reports are currently available: text - detailed textual summary html - detailed HTML reports html_basic - detailed HTML reports with syntax highlighting compilation - output in a format similar to Perl =head1 OPTIONS The following command line options are supported: -h -help - show help -i -info - show documentation -v -version - show version -silent - don't print informational messages (default off) -summary - give summary report (default on) -report report_format - report format (default html) -outputdir - directory for output (default db) -launch - launch report in viewer (if avail) (default off) -select filename - only report on the file (default all) -ignore filename - don't report on the file (default none) -select_re RE - append to REs of files to select (default none) -ignore_re RE - append to REs of files to ignore (default none) -write [db] - write the merged database (default off) -delete - drop database(s) (default off) -dump_db - dump database(s) (for debugging) (default off) -coverage criterion - report on criterion (default all available) -test - drop database(s) and run make test (default off) -gcov - run gcov to cover XS code (default on if using gcc) -make make_prog - use the given 'make' program for 'make test' other options specific to the report format =head1 REPORT FORMATS Tool accepts -report option: =over 4 =item html|html_minimal (default) HTML reporting. Percentage thresholds are color-coded and configurable via -report_c0 , -report_c1 and -report_c2 .: 0% 75% 90% 100% | .. | .. | .. | or L module is detected. Like html|html_minimal reporting, percentage thresholds are color-coded and configurable. =item text Plain text reporting. =item compilation Like text but hacked to give a minimal output in a format similar to that output by Perl itself so that it's easier to step through the untested locations with Emacs compilation mode. =back =head1 DETAILS Any number of coverage databases may be specified on the command line. These databases will be merged and the reports will be based on the merged information. If no databases are specified the default database (cover_db) will be used. The -write option will write out the merged database. If no name is given for the new database, the first database read in will be overwritten. When this option is used no reports are generated by default. Specify the -select, -select_re, -ignore, and -ignore_re options to report on specific files. -select and -ignore are interpreted as shell globs; -select_re and -ignore_re are interpeted as regular expressions. Specify -coverage options to report on specific criteria. By default all available information on all criteria in all files will be reported. Available coverage options are statement, branch, condition, subroutine, and pod. However, if you know you only want coverage information for certain criteria it is better to only collect data for those criteria in the first place by specifying them at that point. This will make the data collection and reporting processes faster and less memory intensive. See the documentation for L for more information. The -test option will delete the databases and run your tests to generate new coverage data before reporting on it. L knows how to work with standard Perl Makefiles as well as L based distributions. For detailed instructions see the documentation for ExtUtils::MakeMaker at L or for Module::Build at L both of which come as standard in recent Perl distributions. The -gcov option will try to run gcov on any XS code. This requires that you are using gcc of course. If you are using the -test option will be turned on by default. =head1 EXIT STATUS The following exit values are returned: 0 All operations were completed successfully. >0 An error occurred. With the -test option the exit status of the underlying test run is returned. =head1 SEE ALSO L =head1 BUGS Did I mention that this is alpha code? See the BUGS file. =head1 LICENCE Copyright 2001-2013, Paul Johnson (paul@pjcj.net) This software is free. It is licensed under the same terms as Perl itself. The latest version of this software should be available from my homepage: http://www.pjcj.net =cut META.json100644001750001750 1743012206216060 14336 0ustar00pjcjpjcj000000000000Devel-Cover-1.08{ "abstract" : "Code coverage metrics for Perl", "author" : [ "Paul Johnson " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.300034, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Devel-Cover", "no_index" : { "directory" : [ "tests", "t", "utils" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "recommends" : { "Browser::Open" : "0", "JSON::PP" : "0", "PPI::HTML" : "1.07", "Parallel::Iterator" : "0", "Perl::Tidy" : "20060719", "Pod::Coverage" : "0.06", "Pod::Coverage::CountParents" : "0", "Template" : "2.00", "Test::Differences" : "0", "perl" : "5.008002" }, "requires" : { "Digest::MD5" : "0", "Storable" : "0", "perl" : "5.006001" } }, "test" : { "recommends" : { "Test::Differences" : "0" }, "requires" : { "Test::More" : "0", "Test::Warn" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/pjcj/Devel--Cover/issues" }, "homepage" : "http://www.pjcj.net/perl.html", "license" : [ "http://dev.perl.org/licenses" ], "repository" : { "type" : "git", "url" : "http://github.com/pjcj/Devel--Cover", "web" : "http://github.com/pjcj/Devel--Cover" }, "x_mailing_list" : "http://lists.perl.org/list/perl-qa.html" }, "version" : "1.08", "x_Dist_Zilla" : { "perl" : { "version" : "5.018000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::VersionFromScript", "name" : "VersionFromScript", "version" : "0.017" }, { "class" : "Dist::Zilla::Plugin::Run::BeforeBuild", "name" : "Run::BeforeBuild", "version" : "0.020" }, { "class" : "Dist::Zilla::Plugin::GatherDir", "name" : "GatherDir", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "ManifestSkip", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "ExecDir", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::OurPkgVersion", "name" : "OurPkgVersion", "version" : "0.004000" }, { "class" : "Dist::Zilla::Plugin::PodVersion", "name" : "PodVersion", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "MetaYAML", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "MetaJSON", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "MetaConfig", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "MetaResources", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "MetaNoIndex", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "Manifest", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "recommends" } }, "name" : "Recommends", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "configure", "type" : "requires" } }, "name" : "ConfigureRequires", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "TestRequires", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "recommends" } }, "name" : "TestRecommends", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Run::Test", "name" : "Run::Test", "version" : "0.020" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "name" : "Git::Check", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "NextRelease", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "name" : "Git::Commit", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "name" : "Git::Tag", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "TestRelease", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "ConfirmRelease", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "UploadToCPAN", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "4.300034" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : "0" }, "version" : "4.300034" } } } .gitignore100644001750001750 40112206216060 14633 0ustar00pjcjpjcj000000000000Devel-Cover-1.08*.org *.bak *~ Cover.bs Cover.c Cover.o Makefile Makefile.old blib/ cover_db*/ t/e2e/ lib/Devel/Cover/Inc.pm pm_to_blib *.out *.tar.bz2 *.tar.gz *.patch *.orig *.rej tmp/ MYMETA.* Cover.def dll.base dll.exp Devel-Cover-* tags README .build/ callgrind.out.* skip100644001750001750 61612206216060 14706 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net sub main { my ($debug) = @_; print "main\n"; print "debug1\n" if $debug; if ($debug) { print "debug2\n"; } } main 0; exec100644001750001750 44612206216060 14665 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2007-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net $x = 1; exec "echo foo"; die "Unreachable"; sort100644001750001750 124412206216060 14745 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl -w use strict; my %sort = ( B => \&backwards, F => \&forwards ); sub backwards { return $b cmp $a; } sub forwards { return $a cmp $b; } sub GetAlgorithm { my ($alg) = @_; return $sort{$alg}; } my @list = qw( a d e c g ); # my $alg = GetAlgorithm(('B', 'F')[int(rand(2))]); my $alg = GetAlgorithm(('B', 'F')[0]); @list = sort {&{$alg}} @list; use Data::Dumper; print STDERR Dumper(\@list); package Failure; sub fail { my @x = 1 .. 5; my @y = sort { Failure->xyz( $a, $b ) } @x; } sub xyz { my $self = shift; my ($a, $b) = @_; $a <=> $b; } package main; my @l = Failure->fail; print STDERR Dumper(\@l); fork100644001750001750 73512206216060 14703 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ skip_test $^O eq "MSWin32" || $] == 5.008007 # __COVER__ skip_reason Fork unreliable $x = 1; die unless defined ($pid = fork); if ($pid) { $x = 2; waitpid $pid, 0; } else { $x = 3; } print "$x: $$\n"; .travis.yml100644001750001750 22212206216060 14755 0ustar00pjcjpjcj000000000000Devel-Cover-1.08language: perl perl: - "5.10" - "5.12" - "5.14" - "5.16" - "5.18" notifications: email: on_success: always on_failure: always Makefile.PL100644001750001750 3562012206216060 14670 0ustar00pjcjpjcj000000000000Devel-Cover-1.08#!/usr/bin/perl # Copyright 2001-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net require 5.006001; use strict; use warnings; use Cwd; use ExtUtils::MakeMaker; use File::Copy; $| = 1; my $Version = "1.08"; my $Author = 'paul@pjcj.net'; my @perlbug = ("perlbug", "-a", $Author, "-s", "Installation of Devel::Cover $Version"); my $Perlbug = join " ", map { / / ? "'$_'" : $_ } @perlbug; my $base = getcwd; my %inc = map { -d $_ ? (($_ eq "." ? $_ : Cwd::abs_path($_)) => 1) : () } @INC; my @inc = sort keys %inc; open I, ">lib/Devel/Cover/Inc.pm" or die "Cannot open lib/Devel/Cover/Inc.pm: $!"; print I <<"EOI"; # Copyright 2001-2013, Paul Johnson (paul\@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # This file was automatically generated by Makefile.PL. package Devel::Cover::Inc; use strict; use warnings; our \$VERSION = "$Version"; our \$Perl_version = '$]'; our \$Base = '$base'; our \@Inc = qw( @inc ); chomp (our \$Perl = <<'EOV'); # Careful with \\\\ in the path $^X EOV if (\$Perl_version ne \$]) { print STDERR <<"EOM"; This version of Devel::Cover was built with Perl version \$Perl_version. It is now being run with Perl version \$]. Attempting to make adjustments, but you may find that some of your modules do not have coverage data collected. You may need to alter the +-inc, +-ignore and +-select options. EOM eval "use Cwd"; my \%inc = map { -d \$_ ? ((\$_ eq "." ? \$_ : Cwd::abs_path(\$_)) => 1) : () } \@INC; \@Inc = sort keys \%inc; } # TODO - check for threadedness, 64bits etc. ? 1 EOI close I or die "Cannot close lib/Devel/Cover/Inc.pm: $!"; print "Writing tests ........ "; for my $d (qw( t t/e2e )) { unless (mkdir $d) { die "Cannot mkdir $d: $!" unless -d $d; } } my @tests; opendir D, "tests" or die "Cannot opendir tests: $!"; for my $t (readdir D) { next unless -f "tests/$t"; next if $t =~ /\.(pm|pl|org|bak|uncoverable)$/; next if $t =~ /~$/; push @tests, $t; if ($t =~ /\.t/) { copy("tests/$t", "t/e2e/$t") or die "Cannot copy tests/$t to t/e2e/$t: $!"; next } open T, ">t/e2e/a$t.t" or die "Cannot open t/e2e/a$t.t: $!"; print T <new("$t"); \$test->run_test; no warnings; \$test # for create_gold EOT close T or die "Cannot close t/e2e/a$t.t: $!"; } closedir D or die "Cannot closedir tests: $!"; s/^/tests\// for @tests; push @tests, grep !/e2e/, glob "t/*/*.t"; if ($ENV{DEVEL_COVER_NO_TESTS}) { # don't run tests under p5cover print "removing all tests with DEVEL_COVER_NO_TESTS\n"; system "rm -rf t/*"; # TODO portability @tests = (); } print "done\n\n"; my %checked; sub check { my ($module, $text, $version) = @_; printf "checking for %-18s %-16s .... ", $module, $version ? "version $version" : ""; { local $SIG{__WARN__} = sub {}; eval "use $module"; } (my $mod = $module) =~ s/::/\//g; if (my $m = $INC{"$mod.pm"}) { my $v = eval { no warnings; eval "\$${module}::VERSION" }; printf "%-8s $m\n", $v; if ($version && $v < $version) { print "\n\n\n$text\n" unless $checked{$text}++; print "\n"; } } else { print "not found"; print "\n\n\n$text\n" unless $checked{$text}++; print "\n"; } }; my $d = < $latest_tested; Devel::Cover $Version has not been tested with perl $]. Testing will take place against expected output from perl $latest_tested. You may well find failing tests. EOM if ($] < 5.008) { print < "Devel::Cover", VERSION => $Version, AUTHOR => 'Paul Johnson ', ABSTRACT_FROM => "lib/Devel/Cover.pm", DIR => [], EXE_FILES => [ map "bin/$_", qw( cover gcov2perl cpancover ) ], PERL_MALLOC_OK => 1, PREREQ_PM => { Storable => 0, "Digest::MD5" => 0, $ENV{DEVEL_COVER_NO_TESTS} ? () : ( "Test::More" => 0, "Test::Warn" => 0 ) }, TYPEMAPS => [ "utils/typemap" ], clean => { FILES => "t/e2e/* cover_db* t/e2e/*cover_db " . "README *.gcov *.out" }, dist => { COMPRESS => "gzip --best --force" }, test => { TESTS => $ENV{DEVEL_COVER_NO_TESTS} ? "" : "t/*/*.t" }, realclean => $] < 5.008008 ? { FILES => "lib/Devel/Cover/Inc.pm", POSTOP => "\$(RM_RF) cover_db t/e2e" } : { FILES => "lib/Devel/Cover/Inc.pm cover_db t/e2e" }, }; # use Data::Dumper; print Dumper $opts; WriteMakefile(%$opts); print "\n"; print < README show_version : \t \@echo \$(VERSION) ppm : ppd pure_all \t tar cf Devel-Cover.tar blib \t gzip --best --force Devel-Cover.tar \t \$(PERL) -pi.bak \\ -e 's/(OS NAME=")[^"]*/\$\$1MSWin32/;' \\ -e 's/(ARCHITECTURE NAME=")[^"]*/\$\$1MSWin32-x86-multi-thread/;' \\ -e 's/(CODEBASE HREF=")[^"]*/\$\$1Devel-Cover.tar.gz/;' \\ Devel-Cover.ppd TAINT = TAINT = -T COVER_OPTIONS = PERL5OPT = _run : pure_all \t \$(PERL) \$(TAINT) -Iblib/lib -Iblib/arch -MDevel::Cover=-merge,0,`\$(PERL) -e '\$\$l = qx|grep __COVER__ \$\$ARGV[0]|; \$\$l =~ /__COVER__\\s+criteria\\s+(.*)/; (\$\$c = \$\$1 || "all") =~ s/\\s+/,/g; \$\$p = "\$\$1," if \$\$l =~ /__COVER__\\s+test_parameters\\s+(.*)/; print "\$\$p-coverage,\$\$c"' tests/\$(TEST)`,\$(COVER_OPTIONS) tests/\$(TEST) COVER_PARAMETERS = \$(PERL) -e '\$\$l = qx|grep __COVER__ \$\$ARGV[0]|; \$\$u = "-uncoverable_file \$\$1" if \$\$l =~ /__COVER__\\s+uncoverable_file\\s+(.*)/; (\$\$p) = \$\$l =~ /__COVER__\\s+cover_parameters\\s+(.*)/; print "\$\$u \$\$p"' tests/\$(TEST) html : _run \t \$(PERL) -Mblib bin/cover `\$(COVER_PARAMETERS)` -report html basic : _run \t \$(PERL) -Mblib bin/cover `\$(COVER_PARAMETERS)` -report html_basic out : _run \t \$(PERL) -Mblib bin/cover `\$(COVER_PARAMETERS)` -report text > \$(TEST).out text : out \t \$(VISUAL) \$(TEST).out wrun : pure_all \t \$(PERL) \$(TAINT) -Iblib/lib -Iblib/arch -MDevel::Cover=-ignore,blib,-merge,0 tests/\$(TEST) prove : pure_all \t \$(PERL) -Iutils -MDevel::Cover::BuildUtils=prove_command -le '\$\$c = prove_command and print \$\$c and system \$\$c' t : pure_all \t \$(PERL) -Mblib bin/cover -delete \t exec make test HARNESS_OPTIONS=j`\$(PERL) -Iutils -MDevel::Cover::BuildUtils=nice_cpus -e 'print nice_cpus'`:c HARNESS_TIMER=1 DB = cover_db dump : \t \$(PERL) -Mblib bin/cover -dump_db \$(DB) FONT = "Inconsolata 10" GEOM = 260x85+0+0 diff : out \t \$(PERL) utils/makeh strip_criterion 'time' \$(TEST).out \t \$(PERL) utils/makeh strip_criterion ' pod' \$(TEST).out \t gold="`\$(PERL) -Mblib -MDevel::Cover::Test -e '\$\$t = Devel::Cover::Test->new(qq(\$(TEST))); print join qq(.), \$\$t->cover_gold'`" && gvim -geom \$(GEOM) -d -font \$(FONT) "\$\$gold" \$(TEST).out gold : pure_all \t \$(PERL) utils/create_gold \$(TEST) all_test : \t exec \$(PERL) utils/all_versions make t all_gold : \t \$(PERL) utils/create_all_gold \$(TEST) _delete_db : pure_all \t rm -rf cover_db _self_cover_tests : @{[sort values %tests]} \t DEVEL_COVER_SELF=1 \$(PERL) -Mblib -MDevel::Cover bin/cover -silent -write cover_db @{[sort values %tests]} self_cover : _self_cover_reports \t \$(PERL) -Mblib bin/cover -report html_basic -launch \t \$(PERL) -Mblib bin/cover -report vim ok : \t \@$Perlbug -okay || echo "Please send your report manually to $Author" nok : \t \@$Perlbug -nokay || echo "Please send your report manually to $Author" ] . "\n" . join "\n", map("$tests{$_} : _delete_db\n" . "\t \@echo Running $tests{$_}\n" . "\t \@rm -rf $tests{$_}\n" . "\t \@DEVEL_COVER_SELF=1 \$(PERL) -Mblib -MDevel::Cover=-db,$tests{$_},-silent,1,-coverage,all,-ignore,tests/,-coverage,pod-also_private-xx $_\n", sort keys %tests), "_self_cover_reports : @{[map qq(report_$_), @reports]}\n", map("report_$_ : _self_cover_tests\n" . "\t \@echo Generating $_ report\n" . "\t \@DEVEL_COVER_SELF=1 \$(PERL) -Mblib -MDevel::Cover bin/cover -silent -report $_ > /dev/null\n", @reports) } alias100644001750001750 76512206216060 15036 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net package Foo; sub is_3digits { my $val = shift; my $retval = undef; $retval=1 if $val =~ /^\d{3}$/; return $retval; } package main; *main::is_3digits = *Foo::is_3digits; # delete $Foo::{is_3digits}; is_3digits(1234); is_3digits(123); taint100644001750001750 47412206216060 15061 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; use lib "tests"; use Taint; print "taint\n"; md5.t100644001750001750 217212206216060 14706 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; use File::Copy; use Devel::Cover::Inc; use Devel::Cover::Test; my $base = $Devel::Cover::Inc::Base; my $t = "md5"; my $ft = "$base/tests/$t"; my $fg = "$base/tests/trivial"; if ($] == 5.008007) { eval "use Test::More skip_all => 'Crashes 5.8.7'"; exit; } my $run_test = sub { my $test = shift; copy($fg, $ft) or die "Cannot copy $fg to $ft: $!"; open T, ">>$ft" or die "Cannot open $ft: $!"; print T "# blah blah\n"; close T or die "Cannot close $ft: $!"; $test->run_command($test->test_command); sleep 1; copy($fg, $ft) or die "Cannot copy $fg to $ft: $!"; $test->{test_parameters} .= " -merge 1"; $test->run_command($test->test_command); }; my $test = Devel::Cover::Test->new ( $t, run_test => $run_test, end => sub { unlink $ft }, ); $test->run_test; no warnings; $test # for create_gold E2.pm100644001750001750 40512206216060 14615 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests# Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net package E2; print "E2\n"; 1 eval1100644001750001750 113212206216060 14762 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ skip_test $] == 5.010 # __COVER__ skip_reason One test fails only under make test on 5.10.0 unhreaded use strict; use warnings; use lib -d "t" ? "t" : ".."; my $x; eval <<'EOS'; sub e { $x++; $x } EOS eval <<'EOS'; sub f { $x++; $x } sub g { $x++; } sub h { $x++; } EOS e(); e(); e(); f(); f(); h(); h(); h(); eval3100644001750001750 77612206216060 14761 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use lib "tests"; $x = shift || 0; print "1 - $x\n"; if ($x) { eval 'sub s1 { print "s1\n" }'; s1() } print "3 - $x\n"; if ($x < 4) { eval 'sub s2 { print "s2\n" }'; s2() } print "4 - $x\n"; if ($x < 6) { eval 'sub s3 { print "s3\n" }'; s3() } print "5 - $x\n"; E4.pm100644001750001750 40512206216060 14617 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests# Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net package E4; print "E4\n"; 1 E3.pm100644001750001750 40512206216060 14616 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests# Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net package E3; print "E3\n"; 1 eval2100644001750001750 67112206216060 14752 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use lib "tests"; $x = shift || 0; print "1 - $x\n"; if ($x) { eval 'use E2' } print "3 - $x\n"; if ($x < 4) { eval 'use E3' } print "4 - $x\n"; if ($x < 6) { eval 'use E4' } print "5 - $x\n"; makeh100644001750001750 150712206216060 15043 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/utils#!/usr/bin/perl # Copyright 2001-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; my $Command = { strip_criterion => sub { my ($command, $criterion, $file) = @_; my $t; local ($^I, @ARGV) = (".bak", $file); while (<>) { $t = index($_, "$criterion code") -3 if !defined $t || $t < 0; substr $_, $t, 7, "" if /^line err stmt/ .. /^--------/ and $t > -1 and length > $t; print; } }, }; sub main { my ($command) = @ARGV; die "No such command: $command" unless $Command->{$command}; $Command->{$command}->(@ARGV) } main bigint100644001750001750 52212206216060 15210 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2012-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; use Math::BigInt ":constant"; my $x = 1; print $x if 1 >= $x; COP.pm100644001750001750 3012206216060 14742 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#line 64 "Parser.yp" 1; alias1100644001750001750 53312206216060 15110 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; use lib "tests"; use Alias1; is_3digits(1234); is_3digits(123); exit; RELEASE100644001750001750 126312206216060 14625 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/docs1. Update Changes. - Add important changes. - Credit the author as appropriate. - Include RT numbers. 2. Check it in. $ git commit -m "Add Changes." Changes 3. Update version number in Makefile.PL. 4. Check it in. $ git commit -m "Bump version number." Makefile.PL 5. Run basic tests. $ perl Makefile.PL && make $ make test 6. Test against all versions. $ make all_test - or, if you have multiple cores available: $ HARNESS_OPTIONS=j6:c HARNESS_TIMER=1 make all_test 7. Return to base perl version. $ perl Makefile.PL && make 8. Make the release. $ dzil release 9. Push the changes. - The dzil Git::Push plugin hangs for me $ git push $ git push --tags MANIFEST.SKIP100644001750001750 36012206216060 14545 0ustar00pjcjpjcj000000000000Devel-Cover-1.08\.org$ \.bak$ ~$ \.orig$ Makefile$ Makefile\.old$ blib/ pm_to_blib$ \.version$ ^t/e2e/ \.gz$ \.c$ \.o$ \.bs$ cover_db/ core$ \.out$ lib/Devel/Cover/Inc.pm$ ^Devel-Cover- \.patch$ \.rej$ \.debug$ ^tmp/ ^bugs/ \.git/ \.tar.bz2$ MYMETA\. tags require100644001750001750 52412206216060 15412 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use lib -d "t" ? "." : ".."; use File::Spec; require File::Spec->catfile("tests", "E2.pm"); inc_sub100644001750001750 117412206216060 15402 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ changes s/(2[12] )\d/$1X/ # __COVER__ changes s/(22 100 )\d/$1X/ use lib (); BEGIN { lib->import ( sub { print map("[$_]", @_), "\n"; return unless $_[1] eq "IncSub.pm"; my $fh; open $fh, "tests/IncSub.pm" or die $!; $fh } ) } use IncSub; IncSub::check destroy100644001750001750 57112206216060 15431 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net package Destroy; sub new { bless {}, shift } my $x; sub DESTROY { $x++; $x++; } package main; my $d = Destroy->new; module1100644001750001750 72712206216060 15311 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ changes s/56.3/56.2/ use strict; use warnings; use lib "tests"; use Module1; my @x; sub xx { $x[shift]++; Module1::zz(0); } for (0 .. 10) { if (time) { xx(0); } else { $x[1]++; } } deparse100644001750001750 56312206216060 15364 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl -l # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net use strict; use warnings; use B::Deparse; my $xx = sub { print "xx"; }; print B::Deparse->new->coderef2text($xx) trivial100644001750001750 40312206216060 15404 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2004-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net my $x = 1; bug_and100644001750001750 107712206216060 15361 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net my $x = 1; my $y = 1; if ($x && !$y) { die "Urgh"; } if ($x && $y) { } unless ($x && $y) { die "Urgh"; } if (!($x && $y)) { die "Urgh"; } # TODO - this does not get reported on correctly. It is reported identically # to the first case, but it should be the same as cases 2 - 4. if (!$x || !$y) { die "Urgh"; } cond_or100644001750001750 321012206216060 15374 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ skip_test $] < 5.008 || $^O eq "cygwin" # __COVER__ skip_reason Busted on 5.6 and cygwin use strict; use warnings; my @x; my $y = 1; my $z = 0; $::foo = 17; if ($] >= 5.009) { $ENV{PATH} = "/bin"; system "pwd"; use lib "tests"; my $file = "cond_or.pl"; unless (my $return = do $file) { die "couldn't parse $file: $@" if $@; die "couldn't do $file: $!" unless defined $return; die "couldn't run $file" unless $return; } } for my $i (0 .. 10) { $y || $x[1]++; $y || $x[0]++ || $x[1]++; $x[2]++ unless $z; for (0 .. 2) { $x[3]++; } if ($z) { $x[4]++; } else { $x[5]++; } my $p = $y || $z; my $q = $z || $y; my $r = $i || "qqq"; my $s = $i || []; my $t = $y | $z; my $u = $y || 0; my $v = $y || undef; my $w = $z || 0; $p ||= $y; $p ||= $z; $x[ 6] ||= $y; $x[ 7] ||= $z; $x[ 8] ||= 1; $x[ 9] ||= {}; $x[10] ||= \"foo"; $x[11] ||= \$y; $x[12] ||= \*STDIO; $x[13] ||= sub { 1 }; $x[14] ||= *::foo{SCALAR}; $x[15] ||= *STDIO{IO}; $x[16] ||= bless {}, "XXX"; $x[17] ||= $i == 1; $w ||= ref($i) eq "SCALAR"; $x[18] ||= <<"EOD"; blah EOD cond_dor(\@x) if exists &cond_dor; sub { $x[19] ||= 1 }; } # print join(", ", @x), "\n"; module2100644001750001750 73212206216060 15306 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/tests#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net # __COVER__ changes s/56.3/56.2/ use strict; use warnings; use lib "tests"; use Module2; my @x; sub xx { $x[shift]++; NotModule2::zz(0); } for (0 .. 10) { if (time) { xx(0); } else { $x[1]++; } } gcov2perl100644001750001750 1343212206216060 15311 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/bin#!/usr/bin/perl # Copyright 2001-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net require 5.6.1; use strict; use warnings; our $VERSION = '1.08'; # VERSION use Devel::Cover::DB; use File::Path; use File::Spec; use Getopt::Long; use Pod::Usage; my $Options = { db => "cover_db", }; sub get_options { die "Bad option" unless GetOptions($Options, # Store the options in the Options hash. qw( db=s help|h! info|i! version|v! )); print "$0 version " . __PACKAGE__->VERSION . "\n" and exit 0 if $Options->{version}; pod2usage(-exitval => 0, -verbose => 0) if $Options->{help}; pod2usage(-exitval => 0, -verbose => 2) if $Options->{info}; } sub add_cover { my ($file) = @_; my ($vol, $dir) = File::Spec->splitpath(File::Spec->rel2abs($file)); $dir = File::Spec->catpath($vol, $dir); my $f = $file; $f =~ s/.gcov$//; my %run; $run{collected} = ["statement"]; $run{start} = $run{finish} = time; my $structure = Devel::Cover::DB::Structure->new; $structure->add_criteria("statement"); $structure->add_criteria("branch"); my $statement_re = qr/^\s*([-0-9#]+):\s*(\d+):(.*)/; my $branch_re = qr/^branch\s+(\d+)\s+(?:taken|never)\s+(\w+)/; my ($line, $text); open F, $file or die "Can't open $file: $!\n"; gcov_line: while (my $gcov_text = ) { # print "Processing line [$gcov_text]\n"; if ($gcov_text =~ /^[^:]+:[^:]+:Source:(.*)$/) { $f = $1; $f = File::Spec->abs2rel(File::Spec->catfile($dir, $f)) unless File::Spec->file_name_is_absolute($f); } unless (defined $run{digests}{$f}) { unless (-f $f) { warn "no source $f found for $file\n"; close F or die "Can't close $file: $!\n"; return; } $run{digests}{$f} = $structure->set_file($f); } if ($gcov_text =~ $statement_re) { my $count = $1; $line = $2; $text = $3; next if $count eq "-"; $count = 0 if $count eq "#####"; # print "$f:$line - $count\n"; push @{$run{count}{$f}{statement}}, $count; $structure->add_statement($f, $line); } elsif ($gcov_text =~ $branch_re) { my @branches; # look for: # branch 0 taken 0 (fallthrough) # branch 1 taken 19 # branch 0 never executed # branch 1 never executed while ($gcov_text =~ $branch_re) { push @branches, $2 eq "executed" ? 0 : $2; $gcov_text = ; } # print "branches on $f:$line are: @branches\n"; if (@branches == 2) { $structure->add_branch($f, [ $line, { text => $text } ]); push @{$run{count}{$f}{branch}}, \@branches; } else { warn "gcov2perl: Warning: ignoring branch with ", scalar @branches, " targets at $f:$line $text\n"; } redo gcov_line; # process the line after the branch data } } close F or die "Can't close $file: $!\n"; my $run = $run{start} . ".$$." . sprintf "%05d", rand 2 ** 16; my $db = $Options->{db}; my $cover = Devel::Cover::DB->new ( base => $db, runs => { $run => \%run }, structure => $structure, ); $db .= "/runs"; mkpath $db unless -d $db; $db .= "/$run"; $cover->{db} = $db; print STDOUT "gcov2perl: Writing coverage database to $db\n"; $cover->write; } sub main { get_options; add_cover $_ for @ARGV; } main __END__ =head1 NAME gcov2perl - convert gcov files to Devel::Cover databases =head1 VERSION version 1.08 =head1 SYNOPSIS gcov2perl -h -i -v -db database gcov_files =head1 DESCRIPTION Convert gcov files to Devel::Cover databases. =head1 OPTIONS The following command line options are supported: -db database - specify the database to use -h -help - show help -i -info - show documentation -v -version - show version =head1 DETAILS To obtain coverage of XS files they must first be compiled with the appropriate options. In a standard Makefile environment, such as that created by ExtUtils::MakeMaker, this can be accomplished with the command: HARNESS_PERL_SWITCHES=-MDevel::Cover make test \ CCFLAGS=-O0\ -fprofile-arcs\ -ftest-coverage \ OTHERLDFLAGS=-fprofile-arcs\ -ftest-coverage If you have already built your object files it may be necessary to run make clean first, or to find some other way to ensure that they get rebuilt with the options gcov requires. Now the code coverage data has been collected C needs to be run: gcov Mylib.xs This will create one or more gcov files on which you can run C: gcov2perl Mylib.xs.gcov Finally, C should be run as usual with any options required: cover If you are running everything with standard options, you can do all this with one command: cover -test =head1 EXIT STATUS The following exit values are returned: 0 All files converted successfully >0 An error occurred. =head1 SEE ALSO Devel::Cover =head1 BUGS Huh? =head1 LICENCE Copyright 2001-2013, Paul Johnson (paul@pjcj.net) This software is free. It is licensed under the same terms as Perl itself. The latest version of this software should be available from my homepage: http://www.pjcj.net =cut cpancover100644001750001750 3243412206216060 15371 0ustar00pjcjpjcj000000000000Devel-Cover-1.08/bin#!/usr/bin/perl # Copyright 2002-2013, Paul Johnson (paul@pjcj.net) # This software is free. It is licensed under the same terms as Perl itself. # The latest version of this software should be available from my homepage: # http://www.pjcj.net require 5.6.1; use strict; use warnings; our $VERSION = '1.08'; # VERSION use Devel::Cover::DB; use Devel::Cover::Dumper; use Cwd (); use Fcntl ":flock"; use Getopt::Long; use Pod::Usage; use Template 2.00; use Parallel::Iterator "iterate_as_array"; # use Carp; $SIG{__DIE__} = \&Carp::confess; $|++; my $Template; my $Options = { collect => 1, directory => Cwd::cwd(), force => 0, module => [], report => "html_basic", }; sub get_options { die "Bad option" unless GetOptions($Options, # Store the options in the Options hash. qw( collect! directory=s force! help|h! info|i! module=s outputdir=s outputfile=s redo_cpancover_html! redo_html! report=s version|v! )); print "$0 version " . __PACKAGE__->VERSION . "\n" and exit 0 if $Options->{version}; pod2usage(-exitval => 0, -verbose => 0) if $Options->{help}; pod2usage(-exitval => 0, -verbose => 2) if $Options->{info}; $Options->{outputdir} ||= $Options->{directory}; $Options->{outputfile} ||= "coverage.html"; push @{$Options->{module}}, @ARGV; if (!$Options->{redo_cpancover_html} && !@{$Options->{module}}) { my $d = $Options->{directory}; opendir D, $d or die "Can't opendir $d: $!\n"; @{$Options->{module}} = grep !/^\./ && -e "$d/$_/Makefile.PL", sort readdir D or die "No module directories found\n"; closedir D or die "Can't closedir $d: $!\n"; } } sub sys { my ($command) = @_; print "$command\n"; system $command; } sub read_results { my $f = "$Options->{outputdir}/cover.results"; my %results; open my $fh, "<", $f or return; my $try; until (flock $fh, LOCK_SH) { die "Can't lock $f: $!\n" if $try++ > 60; sleep 1; } while (<$fh>) { my ($mod, $status) = split; $results{$mod} = $status; } close $fh or die "Can't close $f: $!\n"; \%results } sub get_cover { my ($module) = @_; print "\n\n\n**** Checking coverage of $module ****\n\n\n"; my $d = "$Options->{directory}/$module"; chdir $d or die "Can't chdir $d: $!\n"; my $db = "$d/cover_db"; print "Already analysed\n" if -d $db; my $out = "cover.out"; unlink $out; my $test = !-e "$db/runs" || $Options->{force} ? " -test" : ""; if ($test) { print "Testing $module\n"; sys "$^X Makefile.PL >> $out 2>&1" unless -e "Makefile"; } my $od = "$Options->{outputdir}/$module"; my $of = $Options->{outputfile}; my $timeout = 900; # fifteen minutes should be enough if ($test || !-e "$od/$of" || $Options->{redo_html}) { eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm $timeout; sys "cover$test -report $Options->{report} " . "-outputdir $od -outputfile $of " . ">> $out 2>&1"; alarm 0; }; if ($@) { die unless $@ eq "alarm\n"; # propagate unexpected errors warn "Timed out after $timeout seconds!\n"; } } my $results = read_results; my $f = "$Options->{outputdir}/cover.results"; $results->{$module} = 1; open my $fh, ">", $f or die "Can't open $f: $!\n"; my $try; until (flock $fh, LOCK_EX) { die "Can't lock $f: $!\n" if $try++ > 60; sleep 1; } for my $mod (sort keys %$results) { print $fh "$mod $results->{$mod}\n"; } close $fh or die "Can't close $f: $!\n"; sys "cat $out" if -e $out; } sub write_stylesheet { my $css = "$Options->{outputdir}/cpancover.css"; open CSS, ">", $css or return; print CSS <= 75% * c2 : coverage >= 90% * c3 : path covered or coverage = 100% */ .c0 { background-color: #ff9999; border: solid 1px #cc0000; } .c1 { background-color: #ffcc99; border: solid 1px #ff9933; } .c2 { background-color: #ffff99; border: solid 1px #cccc66; } .c3 { background-color: #99ff99; border: solid 1px #009900; } EOF close CSS or die "Can't close $css: $!\n"; } sub class { my ($pc) = @_; $pc eq "n/a" ? "na" : $pc < 75 ? "c0" : $pc < 90 ? "c1" : $pc < 100 ? "c2" : "c3" } sub write_csv { my ($data) = @_; open(my $fh, ">", "$Options->{outputdir}/cpan_cover.csv") or die "cannot open > cpan_cover.txt: $!"; # TODO GET DISTRIBUTION my @header = qw/release distribution link branch_class branch_details branch_pc condition_class condition_details condition_pc pod_class pod_details pod_pc statement_class statement_details statement_pc subroutine_class subroutine_details subroutine_pc total_class total_details total_pc/; print $fh join(",", @header ) . "\n"; foreach my $release (keys %{$data->{vals}} ) { my $line = []; push @$line, $release, push @$line, $data->{vals}{$release}{link}; foreach my $level1 ( qw/branch condition pod statement subroutine total/ ) { foreach my $level2 ( qw/class details pc/ ) { push @$line, $data->{vals}{$release}{$level1}{$level2}; } } print $fh join ( ",",@$line)."\n"; } close $fh; print "\n\nWrote cpan_cover.csv output to $Options->{outputdir}/cpan_cover.csv\n"; } sub write_html { my $d = $Options->{directory}; chdir $d or die "Can't chdir $d: $!\n"; my $results = read_results; my $f = "$Options->{outputdir}/$Options->{outputfile}"; print "\n\nWriting cpancover output to $f ...\n"; my %vals; my $vars = { title => "CPAN Coverage report", modules => [], vals => \%vals, }; for my $module (sort keys %$results) { my $dbdir = "$Options->{directory}/$module/cover_db"; next unless -d $dbdir; chdir "$Options->{directory}/$module"; print "Adding $module from $dbdir\n"; eval { my $db = Devel::Cover::DB->new(db => $dbdir); # next unless $db->is_valid; my $criteria = $vars->{criteria} ||= [ grep(!/path|time/, $db->all_criteria) ]; $vars->{headers} ||= [ grep(!/path|time/, $db->all_criteria_short) ]; my %options = map { $_ => 1 } @$criteria; $db->calculate_summary(%options); push @{$vars->{modules}}, $module; $vals{$module}{link} = "$module/$Options->{outputfile}"; for my $criterion (@$criteria) { my $summary = $db->summary("Total", $criterion); my $pc = $summary->{percentage}; $pc = defined $pc ? sprintf "%6.2f", $pc : "n/a"; $vals{$module}{$criterion}{pc} = $pc; $vals{$module}{$criterion}{class} = class($pc); $vals{$module}{$criterion}{details} = ($summary->{covered} || 0) . " / " . ($summary->{total} || 0); } } } write_stylesheet; $Template->process("summary", $vars, $f) or die $Template->error(); write_csv($vars); print "done.\n"; print "\n\nWrote cpancover output to $f\n"; } sub main { get_options; $Template = Template->new ({ LOAD_TEMPLATES => [ Devel::Cover::Cpancover::Template::Provider->new({}), ], }); if ($Options->{collect}) { my $workers = $ENV{CPANCOVER_WORKERS} || 0; my @res = iterate_as_array ( { workers => $workers }, sub { eval { get_cover $_[1] }; warn "\n\n\n[$_[1]]: $@\n\n\n" if $@ }, $Options->{module} ); # print Dumper \@res; # get_cover($_) for @{$Options->{module}}; } write_html; } package Devel::Cover::Cpancover::Template::Provider; use strict; use warnings; our $VERSION = '1.08'; # VERSION use base "Template::Provider"; my %Templates; sub fetch { my $self = shift; my ($name) = @_; # print "Looking for <$name>\n"; $self->SUPER::fetch(exists $Templates{$name} ? \$Templates{$name} : $name) } $Templates{colours} = <<'EOT'; [% colours = { default => "#ffffad", text => "#000000", number => "#ffffc0", error => "#ff0000", ok => "#00ff00", } %] [% MACRO bg BLOCK -%] bgcolor="[% colours.$colour %]" [%- END %] EOT $Templates{html} = <<'EOT'; [% PROCESS colours %] [% title %] [% content %] EOT $Templates{summary} = <<'EOT'; [% WRAPPER html %]

[% title %]

[% IF modules %] [% FOREACH header = headers %] [% END %] [% END %] [% FOREACH module = modules %] [% FOREACH criterion = criteria %] [% END %] [% END %]
File [% header %]
[% module %] [% vals.$module.$criterion.pc %]


Coverage information from Devel::Cover by Paul Johnson.
Core coverage (under development)

This server generously donated by bytemark [% END %] EOT ::main __END__ =head1 NAME cpancover - report coverage statistics on CPAN modules =head1 VERSION version 1.08 =head1 SYNOPSIS cpancover -help -info -version =head1 DESCRIPTION =head1 OPTIONS The following command line options are supported: -h -help - show help -i -info - show documentation -v -version - show version =head1 DETAILS =head1 REQUIREMENTS The modules L