[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