[svn:parrot] r45076 - in branches/profiling_testing: . t/profiling

cotto at svn.parrot.org cotto at svn.parrot.org
Sun Mar 21 05:43:04 UTC 2010


Author: cotto
Date: Sun Mar 21 05:43:02 2010
New Revision: 45076
URL: https://trac.parrot.org/parrot/changeset/45076

Log:
[profiling] commit some initial profiling testing code, doesn't test anything meaningful yet

Added:
   branches/profiling_testing/t/profiling/
   branches/profiling_testing/t/profiling/profiling.t   (contents, props changed)
Modified:
   branches/profiling_testing/MANIFEST

Modified: branches/profiling_testing/MANIFEST
==============================================================================
--- branches/profiling_testing/MANIFEST	Sun Mar 21 03:52:10 2010	(r45075)
+++ branches/profiling_testing/MANIFEST	Sun Mar 21 05:43:02 2010	(r45076)
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Fri Mar 19 05:33:57 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Mar 21 05:20:46 2010 UT
 #
 # See below for documentation on the format of this file.
 #
@@ -1970,6 +1970,7 @@
 t/postconfigure/02-data_get_PConfig.t                       [test]
 t/postconfigure/05-trace.t                                  [test]
 t/postconfigure/06-data_get_PConfig_Temp.t                  [test]
+t/profiling/profiling.t                                     [test]
 t/run/README                                                []doc
 t/run/exit.t                                                [test]
 t/run/options.t                                             [test]

Added: branches/profiling_testing/t/profiling/profiling.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/profiling_testing/t/profiling/profiling.t	Sun Mar 21 05:43:02 2010	(r45076)
@@ -0,0 +1,86 @@
+#!/usr/bin/env parrot-nqp
+
+
+my $pir := '
+.sub main
+  say "what"
+.end';
+
+pir::load_bytecode('dumper.pbc');
+pir::load_bytecode('Test/More.pbc');
+
+Test;More;plan(1);
+
+Test;More;ok(1);
+
+my $pprof_str := get_profile_from_pir($pir);
+#pir::say($pprof_str);
+get_profile_array($pprof_str);
+
+
+sub get_profile_array($pprof) {
+
+    my @pprof_lines := pir::split("\n", $pprof);
+    my @pprof := ();
+
+    grammar pprof_line {
+        rule TOP { ^^ [ <fixed_line> | <variable_line> ] $$ }
+        
+        rule fixed_line      { <fixed_line_type> ':' <fixed_line_data> }
+        rule fixed_line_type { [ 'VERSION' | 'CLI' | 'END_OF_RUNLOOP' ] }
+        rule fixed_line_data { \N* }
+
+        rule variable_line      { <variable_line_type> ':' <variable_line_data>* }
+        rule variable_line_type { [ 'CS' | 'OP' ] }
+        rule variable_line_data { '{x{' <field_name> ':' <field_data> '}x}' }
+        rule field_name         { <.ident> }
+        rule field_data         { <[a..zA..Z0..9_\-]>* }
+    }
+
+    for @pprof_lines -> $line {
+        my $line_match := pprof_line.parse($line);
+        #pir::say($line);
+        #_dumper($line_match);
+        @pprof.push($line_match);
+    }
+    @pprof;
+}
+
+sub get_profile_from_pir($pir, $canonical? = 1) {
+
+    my $tmp_pir := '/tmp/test.pir';
+    my $tmp_pprof := '/tmp/test.pprof';
+    my $fh := pir::new__p_sc('FileHandle');
+    $fh.open($tmp_pir, "w");
+    $fh.puts($pir);
+    $fh.close();
+
+    my %env := pir::new__p_sc('Env');
+    %env{'PARROT_PROFILING_FILENAME'} := $tmp_pprof;
+    if $canonical {
+        %env{'PARROT_PROFILING_CANONICAL_OUTPUT'} := 1;
+    }
+    
+    my %config := get_config();
+    my $parrot_exe := %config<prefix> ~ %config<slash> ~ %config<test_prog>;
+
+    my $cli := "$parrot_exe --hash-seed=1234 --runcore profiling $tmp_pir";  
+
+    my $pipe := pir::new__p_sc('FileHandle');
+    $pipe.open($cli, "rp");
+    $pipe.readall();
+    my $exit_status := $pipe.exit_status();
+
+    my $pprof_fh := pir::new__p_sc('FileHandle');
+    $pprof_fh.readall($tmp_pprof);
+}
+
+sub get_config() {
+    return Q:PIR {
+        .include 'iglobals.pasm'
+        .local pmc i
+        i = getinterp
+        %r = i[.IGLOBALS_CONFIG_HASH]
+    };
+}
+        


More information about the parrot-commits mailing list