Revision: 860
Author: tim.bunce
Date: Sat Sep 19 12:39:11 2009
Log: Added endatexit option (for internal use, e.g., by possible  
Devel::NYTProf::PgPlperl module)
Added workaround for current_cv returning NULL.
Fixed compiler warning re lack of prototype for normalize_eval_seqn.

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

Modified:
  /trunk/Changes
  /trunk/NYTProf.xs

=======================================
--- /trunk/Changes      Mon Aug 31 15:04:34 2009
+++ /trunk/Changes      Sat Sep 19 12:39:11 2009
@@ -30,6 +30,8 @@
      slowops=2 puts timings into into the package that made the
      call, e.g., "Foo::CORE:sleep" (note the single colon).

+  Added some support for profiling PostgreSQL PL/Perl code.
+
  Changes to subroutine profiler:

    Rewritten. Captures more data more accurately and robustly.
=======================================
--- /trunk/NYTProf.xs   Mon Aug 31 15:04:34 2009
+++ /trunk/NYTProf.xs   Sat Sep 19 12:39:11 2009
@@ -1206,6 +1206,7 @@
      Hash_entry entry, *found, *parent_entry;
      AV *src_av = Nullav;

+    if (0) memset(&entry, 0, sizeof(entry)); /* handy if debugging */
      entry.key = file_name;
      entry.key_len = (unsigned int)file_name_len;

@@ -1224,8 +1225,8 @@
       * then ensure we've already generated a fid for the underlying
       * filename, and associate that fid with this eval fid
       */
-    if ('(' == file_name[0]) {
-        if (']' == file_name[file_name_len-1]) {
+    if ('(' == file_name[0]) {                      /* first char is '(' */
+        if (']' == file_name[file_name_len-1]) {    /* last char is ']' */
              char *start = strchr(file_name, '[');
              const char *colon = ":";
              /* can't use strchr here (not nul terminated) so use rninstr */
@@ -1235,7 +1236,7 @@
                  logwarn("NYTProf unsupported filename syntax '%s'\n",  
file_name);
                  return 0;
              }
-            ++start;                              /* move past [ */
+            ++start;                                /* move past [ */
              /* recurse */
              found->eval_fid = get_file_id(aTHX_ start, end - start,  
created_via);
              found->eval_line_num = atoi(end+1);
@@ -1940,6 +1941,10 @@
              ? profile_opts |  NYTP_OPTf_SAVESRC
              : profile_opts & ~NYTP_OPTf_SAVESRC;
      }
+    else if (strEQ(option, "endatexit")) {
+        if (atoi(value))
+            PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+    }
      else if (strEQ(option, "zero")) {
          profile_zero = atoi(value);
      }
@@ -2453,6 +2458,13 @@
              sv_setpv(subr_entry->caller_subnam_sv, "RUNTIME"); /* *cough*  
*/
              ++main_runtime_used;
          }
+        else if (caller_cv == 0) {
+            /* should never happen - but does in PostgreSQL 8.4.1 plperl
+             * possibly because perl_run() has already returned
+             */
+            subr_entry->caller_subpkg_pv = "main";
+            sv_setpv(subr_entry->caller_subnam_sv, "NULL"); /* *cough* */
+        }
          else {
              HV *stash_hv = NULL;
              GV *gv = CvGV(caller_cv);
@@ -3444,7 +3456,7 @@
  }


-SV *
+static SV *
  normalize_eval_seqn(pTHX_ SV *sv) {
      /* in-place-edit any eval sequence numbers to 0 */
      int found = 0;

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

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

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

Reply via email to