[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