[svn:parrot] r45201 - in branches/profiling_testing: . runtime/parrot/library/ProfTest t/profiling
cotto at svn.parrot.org
cotto at svn.parrot.org
Sat Mar 27 07:00:41 UTC 2010
Author: cotto
Date: Sat Mar 27 07:00:41 2010
New Revision: 45201
URL: https://trac.parrot.org/parrot/changeset/45201
Log:
[profiling] add some initial incomplete testing support code, hopefully settle on a syntax for the tests
Added:
branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp
branches/profiling_testing/runtime/parrot/library/ProfTest/PIRProfile.nqp
branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp
Modified:
branches/profiling_testing/MANIFEST
branches/profiling_testing/t/profiling/profiling.t
Modified: branches/profiling_testing/MANIFEST
==============================================================================
--- branches/profiling_testing/MANIFEST Sat Mar 27 06:56:07 2010 (r45200)
+++ branches/profiling_testing/MANIFEST Sat Mar 27 07:00:41 2010 (r45201)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sun Mar 21 05:20:46 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat Mar 27 04:26:41 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1239,6 +1239,10 @@
runtime/parrot/library/Parrot/Coroutine.pir [library]
runtime/parrot/library/Parrot/Exception.pir [library]
runtime/parrot/library/Pg.pir [library]
+runtime/parrot/library/ProfTest/Matcher.nqp [library]
+runtime/parrot/library/ProfTest/PIRProfile.nqp [library]
+runtime/parrot/library/ProfTest/ProfTest.nqp [library]
+runtime/parrot/library/ProfTest/Want.nqp [library]
runtime/parrot/library/Protoobject.pir [library]
runtime/parrot/library/Range.pir [library]
runtime/parrot/library/Rules.mak [library]
Added: branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp Sat Mar 27 07:00:41 2010 (r45201)
@@ -0,0 +1,31 @@
+
+class ProfTest::Matcher;
+
+method new(*@args) {
+ self<wants> := ();
+ self<wants>.push(
+ ProfTest::Want::Any.new()
+ );
+ self<wants>.unshift(
+ ProfTest::Want::Goal.new()
+ };
+ for @args -> $arg {
+ self<wants>.push($arg);
+ }
+}
+
+method matches($profile) {
+
+ #if this is the last line
+ #exhaust the current want
+
+ #if we're at a goal
+ #return true
+ #elsif this want accepts the current profile line
+ #if this want is unexhausted, push it onto the backtrack stack
+ #move to the next want and profile line
+ #else
+ #backtrack to the previous unexhausted want
+
+}
+
Added: branches/profiling_testing/runtime/parrot/library/ProfTest/PIRProfile.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/PIRProfile.nqp Sat Mar 27 07:00:41 2010 (r45201)
@@ -0,0 +1,80 @@
+
+class ProfTest::PIRProfile is Hash;
+
+method new($pir_code, $canonical? = 1) {
+ self<canonical> := $canonical;
+ self<pir_code> := $pir_code;
+ self.build_pir_profile;
+ self.build_profile_array;
+ self;
+}
+
+method build_profile_array() {
+
+ my @pprof_lines := pir::split("\n", self<profile>);
+ self<profile_array> := ();
+
+ grammar pprof_line {
+ rule TOP { ^^ [ <variable_line> | <fixed_line> ] $$ }
+
+ rule line_type { [ 'VERSION' | 'CLI' | 'END_OF_RUNLOOP' | 'CS' | 'OP' ] }
+
+ rule fixed_line { <line_type> ':' <fixed_data> }
+ rule fixed_data { \N* }
+
+ rule variable_line { <line_type> ':' <variable_data>* }
+ rule variable_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);
+ self<profile_array>.push($line_match);
+ }
+}
+
+method build_pir_profile() {
+
+ 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(self<pir_code>);
+ $fh.close();
+
+ my %config := self.get_config();
+ my $parrot_exe := %config<prefix> ~ %config<slash> ~ %config<test_prog>;
+ my $hash_seed_opt := '';
+
+ my %env := pir::new__p_sc('Env');
+ %env{'PARROT_PROFILING_FILENAME'} := $tmp_pprof;
+ if self<canonical> {
+ %env{'PARROT_PROFILING_CANONICAL_OUTPUT'} := 1;
+ $hash_seed_opt := '--hash-seed=1234';
+ }
+
+ my $cli := "$parrot_exe $hash_seed_opt --runcore profiling $tmp_pir";
+
+ my $pipe := pir::new__p_sc('FileHandle');
+ $pipe.open($cli, "rp");
+ $pipe.readall();
+ self<exit_status> := $pipe.exit_status();
+
+ my $pprof_fh := pir::new__p_sc('FileHandle');
+ self<profile> := $pprof_fh.readall($tmp_pprof);
+
+ pir::new__p_sc('OS').rm($tmp_pir);
+ pir::new__p_sc('OS').rm($tmp_pprof);
+}
+
+method get_config() {
+ return Q:PIR {
+ .include 'iglobals.pasm'
+ .local pmc i
+ i = getinterp
+ %r = i[.IGLOBALS_CONFIG_HASH]
+ };
+}
Added: branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp Sat Mar 27 07:00:41 2010 (r45201)
@@ -0,0 +1,152 @@
+
+class ProfTest::Want is Hash;
+
+method new() { die('...'); }
+
+method accepts() { 1; }
+
+method hashify_variable_data($data) {
+ my %h := {};
+ for $data -> $match {
+ %h{ $match<field_name> } := $match<field_data>;
+ }
+ %h;
+}
+
+method exhaust() {
+ self<exhausted> := 1;
+}
+
+
+class ProfTest::Want::Goal;
+
+method new() { }
+
+method accepts($prof_line) { 1; }
+
+
+
+class ProfTest::Want::Any;
+
+method new(@except?) {
+ self<except> := @except;
+ self<cursor_pos> := 0;
+ self<exhausted> := 0;
+}
+
+method accepts($prof_line) {
+ my $line_type := $prof_line<variable_line> ??
+ $prof_line<variable_line><line_type> !!
+ $prof_line<variable_line><line_type> ;
+
+ for self<except> -> $except_type {
+ if $except_type eq $line_type {
+ return 0;
+ }
+ }
+ #XXX: how does this get exhausted?
+ return 1;
+}
+
+
+
+class ProfTest::Want::Version is ProfTest::Want;
+
+method new($version?) {
+ self<version> := $version;
+ self<exhausted> := 0;
+}
+
+method accepts($prof_line) {
+ if $prof_line<fixed_line> &&
+ $prof_line<fixed_line><line_type> eq 'VERSION' {
+ self.exhaust;
+ return 1;
+ }
+}
+
+
+
+class ProfTest::Want::CLI is ProfTest::Want;
+
+method new() { self<exhausted> := 1; }
+
+method accepts($prof_line) {
+ if $prof_line<fixed_line> &&
+ $prof_line<fixed_line><line_type> eq 'CLI' {
+ self.exhaust;
+ return 1;
+ }
+}
+
+
+
+class ProfTest::Want::EOR is ProfTest::Want;
+
+method new() { }
+
+method accepts($prof_line) {
+ if $prof_line<fixed_line> &&
+ $prof_line<fixed_line><line_type> eq 'END_OF_RUNLOOP' {
+ self.exhaust;
+ return 1;
+ }
+}
+
+
+
+class ProfTest::Want::Op is ProfTest::Want;
+
+method new($name, $line?) {
+ self<name> := $name;
+ self.exhaust;
+ if $line {
+ self<line> := $line;
+ }
+}
+
+method accepts($prof_line) {
+ if $prof_line<variable_line> && $prof_line<variable_line><line_type> eq 'OP' {
+ my %variable_data := self.hashify_variable_data($prof_line<variable_line><variable_data>);
+ if self<name> ne %variable_data<op> {
+ return 0;
+ }
+ if self<line> && self<line> != %variable_data<line> {
+ return 0;
+ }
+
+ }
+ self.exhaust;
+ return 1;
+}
+
+
+
+class ProfTest::Want::CS is ProfTest::Want;
+
+method new($ns?, :$slurp_until?) {
+ self<ns> := $ns;
+ self<slurp_until> := $slurp_until;
+ self<found_cs> := 0;
+ self.exhaust;
+}
+
+method accepts($prof_line) {
+ if self<found_cs> && self<slurp_until> {
+ #XXX: how to properly exhaust this?
+ return $prof_line<variable_line><line_type> ne self<slurp_until>;
+ }
+ elsif $prof_line<variable_line> && $prof_line<variable_line><line_type> eq 'CS' {
+ if !self<ns> {
+ self<found_cs> := 1;
+ self<exhausted> := !?self<slurp_until>;
+ return 1;
+ }
+ my %h := self.hashify_variable_data($prof_line<variable_line><variable_data>);
+ if %h<ns> eq self<ns> {
+ self<found_cs> := 1;
+ return 1;
+ }
+ }
+ return 0;
+}
Modified: branches/profiling_testing/t/profiling/profiling.t
==============================================================================
--- branches/profiling_testing/t/profiling/profiling.t Sat Mar 27 06:56:07 2010 (r45200)
+++ branches/profiling_testing/t/profiling/profiling.t Sat Mar 27 07:00:41 2010 (r45201)
@@ -14,34 +14,43 @@
my $prof := ProfTest::PIRProfile.new($pir);
+
+ok(1, "profile creation didn't explode");
+ok(1, "profile creation didn't explode");
+
#Does the profile have a version string?
my $matcher := ProfTest::Matcher.new(
- ProfTest::Want::Version.new(),
+ version
);
ok( $matcher.matches($prof), "profile has a version number");
#Does the profile have a CLI invocation?
$matcher := ProfTest::Matcher.new(
- ProfTest::Want::CLI.new()
+ cli
);
ok( $matcher.matches($prof), "profile contains a CLI string");
-
#Does the profile have a 'say' op somewhere?
$matcher := ProfTest::Matcher.new(
- ProfTest::Want::Op.new( :op('say') ));
+ op('say')
);
ok( $matcher.matches($prof), "profile has a say op");
+#Does the profile have expected timing values?
+$matcher := ProfTets::Matcher.new(
+ op('say' :time(1))
+);
+
+ok( $matcher.matches($prof), "profile has canonical timing information");
#Does the profile show a 'say' op inside the 'main' sub?
$matcher := ProfTest::Matcher.new(
- ProfTest::Want::CS.new( :ns('main')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::Op.new( :op('say')),
+ cs(:ns('main')),
+ any(:except('cs'), :count('*')),
+ op('say'),
);
ok( $matcher.matches($prof), "profile shows 'say' inside main sub");
@@ -69,15 +78,11 @@
$prof = ProfTest::PIRProfile.new($pir_code);
$matcher := ProfTest::Matcher.new(
- ProfTest::Want::CS.new( :ns('first')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('second')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('third')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('second')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('first')),
+ cs(:ns('first'), :slurp_until('cs')),
+ cs(:ns('second'), :slurp_until('cs')),
+ cs(:ns('third'), :slurp_until('cs')),
+ cs(:ns('second'), :slurp_until('cs')),
+ cs(:ns('first')),
);
ok( $matcher.matches($prof), "profile properly reflects normal control flow");
@@ -105,13 +110,10 @@
$prof := ProfTest::PIRProfile.new($pir_code);
$matcher := ProfTest::Matcher.new(
- ProfTest::Want::CS.new( :ns('first') ),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('foo')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('bar')),
- ProfTest::Want.new( :count('*'), :type_isnt('CS')),
- ProfTest::Want::CS.new( :ns('first')),
+ cs(:ns('first'), :slurp_until('cs')),
+ cs(:ns('foo'), :slurp_until('cs')),
+ cs(:ns('bar'), :slurp_until('cs')),
+ cs(:ns('first')),
);
ok( $matcher.matches($prof), "profile properly reflects tailcall control flow");
@@ -119,7 +121,7 @@
#Does the profile show a 'say' op on line 2?
$matcher := ProfTest::Matcher.new(
- ProfTest::Want::Op.new( :op('say'), :line('2')),
+ op('say', :line('2')),
);
ok( $matcher.matches($prof), "profile shows say on the correct line");
@@ -133,10 +135,11 @@
$prof := ProfTest::NQPProfile.new($nqp_code, :annotations(1));
-$matcher := ProfTest::Matcher.new();
-$matcher.push( ProfTest::Want::CS.new( :ns('parrot;main') ) ); #matches parrot::foo::main
-$matcher.push( ProfTest::Want.new( :count('*'), :type_isnt('CS') ) );
-$matcher.push( ProfTest::Want::Op.new( :op('say') ) );
+$matcher := ProfTest::Matcher.new(
+ cs(:ns('parrot;main') ),
+ any(:except('cs'), :count('*')),
+ op('say'),
+);
ok( $matcher.matches($prof), "profile shows 'say' inside nqp sub");
More information about the parrot-commits
mailing list