develooper Front page | perl.perl5.porters | Postings from December 2001

Devel::SmallProf broken on bleadperl. Maybe a DB problem?

From:
Michael G Schwern
Date:
December 25, 2001 15:57
Subject:
Devel::SmallProf broken on bleadperl. Maybe a DB problem?
Message ID:
20011225235751.GE28131@blackrider
I just tried to install Devel::SmallProf on bleadperl@13745 and got:

$ bleadperl -Iblib/lib -d:SmallProf -e 1
No DB::DB routine defined at /usr/local/bleadperl/lib/5.7.2/ppc-linux-64int/Time/HiRes.pm line 4.
BEGIN failed--compilation aborted at /usr/local/bleadperl/lib/5.7.2/ppc-linux-64int/Time/HiRes.pm line 4.
Compilation failed in require at blib/lib/Devel/SmallProf.pm line 9.
BEGIN failed--compilation aborted at blib/lib/Devel/SmallProf.pm line 9.
Compilation failed in require.
BEGIN failed--compilation aborted.

It works in 5.6.1, so something changed in DB.pm or Time::HiRes between
then and now.  A hint comes from:

       No DB::DB routine defined
           (F) The currently executing code was compiled with the
           -d switch, but for some reason the perl5db.pl file (or
           some facsimile thereof) didn't define a routine to be
           called at the beginning of each statement.  Which is
           odd, because the file should have been required auto-
           matically, and should have blown up the require if it
           didn't parse right.

So bleadperl is probably trying to call DB::DB on Time::HiRes when its
loaded before DB::DB is defined by SmallProf.

Unfortunately there's a chicken/egg problem.  SmallProf needs
Time::HiRes to initialize itself before DB::DB is called, but it needs
DB::DB to load Time::HiRes.  This can be gotten around by putting in a
dummy DB::DB function just before loading Time::HiRes (patch below).


--- SmallProf.pm	Tue Aug  8 23:47:01 2000
+++ SmallProf.pm	Tue Dec 25 18:55:36 2001
@@ -6,7 +6,11 @@
 
 require 5.000;
 
-use Time::HiRes 'time';
+BEGIN {
+    require Time::HiRes;
+    Time::HiRes->import;
+    sub DB { }
+}
 
 use strict;
 
@@ -46,32 +50,35 @@
   $DB::start = time;
 }
 
-sub DB {
-  my($pkg,$filename,$line) = caller;
-  $DB::profile || return;
-  %DB::packages && !$DB::packages{$pkg} && return;
-  my($u,$s,$cu,$cs) = times;
-  $DB::cdone = $u+$s+$cu+$cs;
-  $DB::done = time;
+{
+  no warnings 'redefine';
+  sub DB {
+    my($pkg,$filename,$line) = caller;
+    $DB::profile || return;
+    %DB::packages && !$DB::packages{$pkg} && return;
+    my($u,$s,$cu,$cs) = times;
+    $DB::cdone = $u+$s+$cu+$cs;
+    $DB::done = time;
 
-  # Now save the _< array for later reference.  If we don't do this here, 
-  # evals which do not define subroutines will disappear.
-  no strict 'refs';
-  $DB::listings{$filename} = \@{"main::_<$filename"} if 
-    defined(@{"main::_<$filename"});
-  use strict 'refs';
-
-  my($delta);
-  $delta = $DB::done - $DB::start;
-  $delta = ($delta > $DB::nulltime) ? $delta - $DB::nulltime : 0;
-  $DB::profiles{$filename}->[$line]++;
-  $DB::times{$DB::prevf}->[$DB::prevl] += $delta;
-  $DB::ctimes{$DB::prevf}->[$DB::prevl] += ($DB::cdone - $DB::cstart);
-  ($DB::prevf, $DB::prevl) = ($filename, $line);
+    # Now save the _< array for later reference.  If we don't do this here, 
+    # evals which do not define subroutines will disappear.
+    no strict 'refs';
+    $DB::listings{$filename} = \@{"main::_<$filename"} if 
+      defined(@{"main::_<$filename"});
+    use strict 'refs';
+
+    my($delta);
+    $delta = $DB::done - $DB::start;
+    $delta = ($delta > $DB::nulltime) ? $delta - $DB::nulltime : 0;
+    $DB::profiles{$filename}->[$line]++;
+    $DB::times{$DB::prevf}->[$DB::prevl] += $delta;
+    $DB::ctimes{$DB::prevf}->[$DB::prevl] += ($DB::cdone - $DB::cstart);
+    ($DB::prevf, $DB::prevl) = ($filename, $line);
 
-  ($u,$s,$cu,$cs) = times;
-  $DB::cstart = $u+$s+$cu+$cs;
-  $DB::start = time;
+    ($u,$s,$cu,$cs) = times;
+    $DB::cstart = $u+$s+$cu+$cs;
+    $DB::start = time;
+  }
 }
 
 END {



-- 

Michael G. Schwern   <schwern@pobox.com>    http://www.pobox.com/~schwern/
Perl Quality Assurance	    <perl-qa@perl.org>	       Kwalitee Is Job One
Fuck with me and I will saw off your legs.
	http://www.unamerican.com/



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About