[svn:parrot] r45232 - in branches/profiling_testing: runtime/parrot/library/ProfTest t/profiling

cotto at svn.parrot.org cotto at svn.parrot.org
Sun Mar 28 06:38:50 UTC 2010


Author: cotto
Date: Sun Mar 28 06:38:50 2010
New Revision: 45232
URL: https://trac.parrot.org/parrot/changeset/45232

Log:
[profiling] various profiling testing fixes
fix Matcher init bugs, fix Want init bugs, add get_str to Want subclasses
use flattening in syntatic sugar subs

Modified:
   branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp
   branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp
   branches/profiling_testing/t/profiling/profiling.t

Modified: branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp
==============================================================================
--- branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp	Sun Mar 28 06:38:13 2010	(r45231)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp	Sun Mar 28 06:38:50 2010	(r45232)
@@ -1,17 +1,19 @@
 
-class ProfTest::Matcher;
+class ProfTest::Matcher is Hash;
 
-method new(*@args) {
+method new(*@wants) {
     self<wants> := ();
-    self<wants>.push(
+    self<wants>.unshift(
         ProfTest::Want::Any.new()
     );
-    self<wants>.unshift(
+    for @wants -> $want {
+        self<wants>.push($want);
+        pir::say("pushed a thing:"~$want.get_str);
+    }
+    self<wants>.push(
         ProfTest::Want::Goal.new()
     );
-    for @args -> $arg {
-        self<wants>.push($arg);
-    }
+    self;
 }
 
 method matches($profile) {
@@ -27,6 +29,7 @@
 
         $curr_line := $profile.profile_array[$line_idx];
         $curr_want := self<wants>[$want_idx];
+        pir::say("current want: "~$curr_want.get_str);
 
         if $curr_want.goal {
             return 1;

Modified: branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp
==============================================================================
--- branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp	Sun Mar 28 06:38:13 2010	(r45231)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp	Sun Mar 28 06:38:50 2010	(r45232)
@@ -5,7 +5,7 @@
 
 method accepts() { 1; }
 
-method hashify_variable_data($data) {
+method hashify_profile_data($data) {
     my %h := {};
     for $data -> $match {
         %h{ $match<field_name> } := $match<field_data>;
@@ -24,18 +24,21 @@
 
 class ProfTest::Want::Goal;
 
-method new() { }
+method new() { self; }
 
 method goal() { 1; }
 
+method get_str() { 'Goal' };
 
 
-class ProfTest::Want::Any;
+
+class ProfTest::Want::Any is ProfTest::Want;
 
 method new(@except?) {
     self<except>     := @except;
     self<cursor_pos> := 0;
     self<exhausted>  := 0;
+    self;
 }
 
 method accepts($prof_line) {
@@ -51,6 +54,15 @@
     return 1;
 }
 
+method get_str() {
+    my $str := 'Any(';
+    if self<except> {
+        $str := $str ~ 'except(' ~ join(',', self<except>) ~ '),';
+    }
+    $str := $str ~ ')';
+    $str;
+}
+
 
 
 class ProfTest::Want::Version is ProfTest::Want;
@@ -58,6 +70,7 @@
 method new($version?) {
     self<version>   := $version;
     self<exhausted> := 0;
+    self;
 }
 
 method accepts($prof_line) {
@@ -68,11 +81,23 @@
     }
 }
 
+method get_str() {
+    my $str := 'Version(';
+    if self<version> {
+        $str := $str ~ 'version(' ~ self<version> ~ ')';
+    }
+    $str := $str ~ ')';
+    $str;
+}
+
 
 
 class ProfTest::Want::CLI is ProfTest::Want;
 
-method new() { self<exhausted> := 1; }
+method new() { 
+    self<exhausted> := 1;
+    self;
+}
 
 method accepts($prof_line) {
     if $prof_line<fixed_line> &&
@@ -82,11 +107,15 @@
     }
 }
 
+method get_str() {
+    "CLI()";
+}
+
 
 
 class ProfTest::Want::EndOfRunloop is ProfTest::Want;
 
-method new() { }
+method new() { self; }
 
 method accepts($prof_line) {
     if $prof_line<fixed_line> &&
@@ -96,6 +125,10 @@
     }
 }
 
+method get_str() {
+    'EndOfRunloop()';
+}
+
 
 
 class ProfTest::Want::Op is ProfTest::Want;
@@ -106,11 +139,12 @@
     if $line {
         self<line> := $line;
     }
+    self;
 }
 
 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>);
+        my %variable_data := self.hashify_profile_data($prof_line<variable_line><variable_data>);
         if self<name> ne %variable_data<op> {
             return 0;
         }
@@ -123,15 +157,24 @@
     return 1;
 }
 
+method get_str() {
+    my $str := 'Op(' ~ self<name>;
+    if self<line> {
+        $str := $str ~ ', :line(' ~ self<line> ~ ')';
+    }
+    $str := $str ~ ')';
+    $str;
+}
+
 
 
 class ProfTest::Want::CS is ProfTest::Want;
 
-method new($ns?, :$slurp_until?) {
+method new(:$ns?, :$slurp_until?) {
     self<ns> := $ns;
     self<slurp_until> := $slurp_until;
     self<found_cs> := 0;
-    self.exhaust;
+    self;
 }
 
 method accepts($prof_line) {
@@ -144,7 +187,7 @@
             self<exhausted> := !?self<slurp_until>;
             return 1;
         }
-        my %h := self.hashify_variable_data($prof_line<variable_line><variable_data>);
+        my %h := self.hashify_profile_data($prof_line<variable_line><variable_data>);
         if %h<ns> eq self<ns> {
             self<found_cs> := 1;
             return 1;
@@ -152,3 +195,16 @@
     }
     return 0;
 }
+
+method get_str() {
+    my $str := 'CS(';
+    if self<ns> {
+        $str := $str ~ ', :ns(' ~ self<ns> ~ '),';
+    }
+    if self<slurp_until> {
+        $str := $str ~ ', :slurp_until(' ~ self<ns> ~ ')';
+    }
+    $str := $str ~ ')';
+    $str;
+}
+

Modified: branches/profiling_testing/t/profiling/profiling.t
==============================================================================
--- branches/profiling_testing/t/profiling/profiling.t	Sun Mar 28 06:38:13 2010	(r45231)
+++ branches/profiling_testing/t/profiling/profiling.t	Sun Mar 28 06:38:50 2010	(r45232)
@@ -20,16 +20,14 @@
 
 #Does the profile have a version string?
 my $matcher := ProfTest::Matcher.new(
-    version
+    version()
 );
 
-pir::exit(0);
-
 ok( $matcher.matches($prof), "profile has a version number");
 
 #Does the profile have a CLI invocation?
 $matcher := ProfTest::Matcher.new(
-    cli
+    cli()
 ); 
 
 ok( $matcher.matches($prof), "profile contains a CLI string");
@@ -48,9 +46,9 @@
 
 ok( $matcher.matches($prof), "profile has canonical timing information");
 
-#Does the matcher fail to find the non-existent 'LOL' opcode?
+#Does the matcher fail to find the non-existent 'lollercoaster' opcode?
 $matcher := ProfTest::Matcher.new(
-    op('LOL')
+    op('lollercoaster')
 );
 
 ok( !$matcher.matches($prof), "matcher didn't find non-existent opcode");
@@ -152,10 +150,12 @@
 
 ok( $matcher.matches($prof), "profile shows 'say' inside nqp sub");
 
+#convenience subs to avoid repetitive typing and visual noise
+
+sub version(*@p, *%n) { ProfTest::Want::Version.new(|@p, |%n) }
+sub cli(*@p, *%n)     { ProfTest::Want::CLI.new(|@p, |%n) }
+sub eor(*@p, *%n)     { ProfTest::Want::EndOfRunloop.new(|@p, |%n) }
+sub op(*@p, *%n)      { ProfTest::Want::Op.new(|@p, |%n) }
+sub cs(*@p, *%n)      { Proftest::Want::CS.new(|@p, |%n) }
+sub any(*@p, *%n)     { ProfTest::Want::Any.new(|@p, |%n) }
 
-sub version($v?)             { ProfTest::Want::Version.new($v) }
-sub cli($c?)                 { ProfTest::Want::CLI.new($c) }
-sub eor()                    { ProfTest::Want::EndOfRunloop.new() }
-sub op($name, $line?)        { ProfTest::Want::Op.new($name, $line) }
-sub cs($ns?, :$slurp_until?) { Proftest::Want::CS.new($ns, :slurp_until($slurp_until)) }
-sub any(@except?)            { ProfTest::Want::Any.new(@except) }


More information about the parrot-commits mailing list