import Devel::Cover 0.46

CHANGES

@@ -304,3 +304,11 @@ Release 0.45 - 27th May 2004
  - 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.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.

Cover.xs

@@ -27,7 +27,7 @@ extern "C" {
 #endif
 
 #define PDEB(a) a
-#define NDEB(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);
@@ -56,8 +56,6 @@ static HV *Cover,
 
 static AV *Ends;
 
-static OP *Profiling_op = 0;
-
 struct unique    /* Well, we'll be fairly unlucky if it's not */
 {
     OP *addr;
@@ -72,6 +70,8 @@ union sequence   /* Hack, hack, hackety hack. */
     char          ch[CH_SZ + 1];
 };
 
+static char Profiling_key[CH_SZ + 1];
+
 #ifdef HAS_GETTIMEOFDAY
 
 #ifdef __cplusplus
@@ -163,7 +163,8 @@ static char *get_key(OP *o)
      */
 
     for (i = 0; i < CH_SZ; i++)
-        /* if (uniq.ch[i] < 32 || uniq.ch[i] > 126 ) */ /* for printing */
+        /* for printing */
+        /* if (uniq.ch[i] < 32 || uniq.ch[i] > 126 ) */
         if (!uniq.ch[i])
             uniq.ch[i] = '-';
 
@@ -474,31 +475,32 @@ static void cover_time()
 {
     SV   **count;
     NV     c;
-    char  *ch;
 
     if (collecting(Time))
     {
         /*
-         * Profiling information is stored against Profiling_op, the one
-         * we have just run.
+         * Profiling information is stored against Profiling_key, the
+         * key for the op we have just run.
          */
 
-        NDEB(D(L, "Cop at %p, op at %p, timing %p\n", PL_curcop, PL_op, Profiling_op));
+        NDEB(D(L, "Cop at %p, op at %p\n", PL_curcop, PL_op));
 
-        if (Profiling_op)
+        if (*Profiling_key)
         {
-            ch    = get_key(Profiling_op);
-            count = hv_fetch(Times, ch, CH_SZ, 1);
+            count = hv_fetch(Times, Profiling_key, CH_SZ, 1);
             c     = (SvTRUE(*count) ? SvNV(*count) : 0) +
 #if defined HAS_GETTIMEOFDAY
                     elapsed();
 #else
                     cpu();
 #endif
             sv_setnv(*count, c);
-            NDEB(D(L, "Adding time: sum %f at %p\n", c, Profiling_op));
+            NDEB(D(L, "Adding time: sum %f to <%s>\n", c, Profiling_key));
         }
-        Profiling_op = PL_op;
+        if (PL_op)
+            strcpy(Profiling_key, get_key(PL_op));
+        else
+            *Profiling_key = 0;
     }
 }
 
@@ -548,6 +550,7 @@ static int runops_cover(pTHX)
         *tmp       = newRV_inc((SV*) Modules);
 
         Pending_conditionals = newHV();
+        *Profiling_key = 0;
     }
 
     if (!module)
@@ -583,7 +586,8 @@ static int runops_cover(pTHX)
                 {
                     SV **f = hv_fetch(Files, file, strlen(file), 0);
                     collecting_here = f ? SvIV(*f) : 1;
-                    NDEB(D(L, "File: %s [%d]\n", file, collecting_here));
+                    NDEB(D(L, "File: %s:%ld [%d]\n",
+                              file, CopLINE(cCOP), collecting_here));
                 }
                 lastfile = file;
             }
@@ -620,8 +624,12 @@ static int runops_cover(pTHX)
         {
 #if CAN_PROFILE
             cover_time();
-            Profiling_op = 0;
+            *Profiling_key = 0;
 #endif
+            if (PL_op->op_type == OP_LEAVESUB)
+                collecting_here = 1;
+            /* Match OP_LEAVESUBLV, OP_LEAVE or others? */
+
             goto call_fptr;
         }
 
@@ -683,7 +691,6 @@ static int runops_cover(pTHX)
         {
 #if CAN_PROFILE
             cover_time();
-            Profiling_op = 0;
 #endif
             break;
         }

MANIFEST

@@ -101,7 +101,6 @@ test_output/cover/dynamic_subs.5.008001
 test_output/cover/eval1.5.006001
 test_output/cover/eval1.5.008
 test_output/cover/fork.5.006001
-test_output/cover/fork.5.008
 test_output/cover/if.5.006001
 test_output/cover/if.5.008
 test_output/cover/module1.5.006001
@@ -110,6 +109,9 @@ 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

META.yml

@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Devel-Cover
-version:      0.45
+version:      0.46
 version_from: 
 installdirs:  site
 requires:

Makefile.PL

@@ -19,8 +19,8 @@ use File::Copy;
 
 $| = 1;
 
-my $Version  = "0.45";
-my $Date     = "27th May 2004";
+my $Version  = "0.46";
+my $Date     = "23rd June 2004";
 my $Author   = 'pjcj@cpan.org';
 
 my @perlbug  = ("perlbug", "-a", $Author,

README

@@ -50,8 +50,9 @@ DESCRIPTION
 REQUIREMENTS
     * Perl 5.6.1 or greater
         Perl 5.7.0 is unsupported. Perl 5.8.1 or greater is recommended.
-        Whilst Perl 5.6 should work you will probably miss out on coverage
-        information which would be available using a more modern version.
+        Whilst Perl 5.6 should mostly work you will probably miss out on
+        coverage information which would be available using a more modern
+        version and will likely run into bugs in perl.
 
     * The ability to compile XS extensions.
         This means a working compiler and make program at least.

TODO

@@ -28,4 +28,5 @@
 - Overhaul test system.  Include patt?
 - Tests for INIT and END blocks included in required files when the
   files are used in some runs.
-- Make all environment variables consistent and document them.
+- Sort out "ignoring extra subroutine" and friends.
+- Fix up make text and friends for module_ignore.

cover

@@ -12,9 +12,9 @@ require 5.6.1;
 use strict;
 use warnings;
 
-our $VERSION = "0.45";
+our $VERSION = "0.46";
 
-use Devel::Cover::DB 0.45;
+use Devel::Cover::DB 0.46;
 
 use Cwd "abs_path";
 use Data::Dumper;
@@ -26,8 +26,8 @@ my $Options =
 {
     coverage    => [],
     delete      => 0,
-    exclude     => [],
-    file        => [],
+    ignore      => [],
+    select      => [],
     report      => "",
     summary     => 1,
     uncoverable => [],
@@ -47,9 +47,9 @@ sub get_options
                        coverage=s
                        delete!
                        dump_db!
-                       exclude=s
+                       ignore=s
                        help|h!
-                       file=s
+                       select=s
                        info|i!
                        outputdir=s
                        report=s
@@ -167,10 +167,10 @@ sub main
 
     # use Data::Dumper;  $Data::Dumper::Indent = 1; print Dumper $db->cover;
 
-    my %f = map { $_ => 1 } (@{$Options->{file}}
-                             ? map glob, @{$Options->{file}}
+    my %f = map { $_ => 1 } (@{$Options->{select}}
+                             ? map glob, @{$Options->{select}}
                              : $db->cover->items);
-    delete @f{map glob, @{$Options->{exclude}}};
+    delete @f{map glob, @{$Options->{ignore}}};
     @{$Options->{file}} = sort grep exists $db->{summary}{$_}, keys %f;
 
     $format->report($db, $Options)
@@ -188,7 +188,7 @@ cover - report coverage statistics
 
  cover -help -info -version
        -summary -report report_format -outputdir dir
-       -file filename -exclude filname
+       -select filename -ignore filname
        -write [db] -delete -dump_db
        -silent
        -coverage criterion
@@ -220,8 +220,8 @@ The following command line options are supported:
  -report report_format - report format required             (default html)
  -outputdir            - directory for output               (default db)
 
- -file filename        - only report on the file            (default all)
- -exclude filename     - don't report on the file           (default none)
+ -select filename      - only report on the file            (default all)
+ -ignore filename      - don't report on the file           (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)
@@ -242,9 +242,9 @@ 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 -file options to report on specific files.  Specify -coverage
-options to report on specific criteria.  By default all available
-information on all criteria in all files will be reported.
+Specify -select and -ignore options to report on specific files.
+Specify -coverage options to report on specific criteria.  By default
+all available information on all criteria in all files will be reported.
 
 =head1 EXIT STATUS
 
@@ -266,7 +266,7 @@ See the BUGS file.
 
 =head1 VERSION
 
-Version 0.45 - 27th May 2004
+Version 0.46 - 23rd June 2004
 
 =head1 LICENCE
 

cpancover

@@ -12,17 +12,17 @@ require 5.6.1;
 use strict;
 use warnings;
 
-our $VERSION = "0.45";
+our $VERSION = "0.46";
 
-use Devel::Cover::DB 0.45;
+use Devel::Cover::DB 0.46;
 
 use Cwd ();
 use File::Find ();
 use Getopt::Long;
 use Pod::Usage;
 use Template 2.00;
 
-use Carp; $SIG{__DIE__} = \&Carp::confess;
+# use Carp; $SIG{__DIE__} = \&Carp::confess;
 
 my $Template;
 
@@ -309,7 +309,7 @@ package Devel::Cover::Cpancover::Template::Provider;
 use strict;
 use warnings;
 
-our $VERSION = "0.45";
+our $VERSION = "0.46";
 
 use base "Template::Provider";
 
@@ -345,7 +345,7 @@ $Templates{html} = <<'EOT';
 
 <!--
 
-This file was generated by Devel::Cover Version 0.45
+This file was generated by Devel::Cover Version 0.46
 
 Devel::Cover is copyright 2001-2004, Paul Johnson (pjcj@cpan.org)
 
@@ -455,7 +455,7 @@ The following exit values are returned:
 
 =head1 VERSION
 
-Version 0.45 - 27th May 2004
+Version 0.46 - 23rd June 2004
 
 =head1 LICENCE
 

create_gold

@@ -12,11 +12,11 @@ require 5.6.1;
 use strict;
 use warnings;
 
-our $VERSION = "0.45";
+our $VERSION = "0.46";
 
 use blib;
 
-use Devel::Cover::Test 0.45;
+use Devel::Cover::Test 0.46;
 
 my @tests = @ARGV;
 

gcov2perl

@@ -12,9 +12,9 @@ require 5.6.1;
 use strict;
 use warnings;
 
-our $VERSION = "0.45";
+our $VERSION = "0.46";
 
-use Devel::Cover::DB 0.45;
+use Devel::Cover::DB 0.46;
 
 use Getopt::Long;
 use Pod::Usage;
@@ -135,7 +135,7 @@ Huh?
 
 =head1 VERSION
 
-Version 0.45 - 27th May 2004
+Version 0.46 - 23rd June 2004
 
 =head1 LICENCE