[svn:parrot] r45269 - branches/profiling_testing/runtime/parrot/library/ProfTest

cotto at svn.parrot.org cotto at svn.parrot.org
Mon Mar 29 06:19:04 UTC 2010


Author: cotto
Date: Mon Mar 29 06:19:04 2010
New Revision: 45269
URL: https://trac.parrot.org/parrot/changeset/45269

Log:
[profiling] make the first 6 tests pass, add optional noisy debugging output

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

Modified: branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp
==============================================================================
--- branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp	Mon Mar 29 05:39:37 2010	(r45268)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/Matcher.nqp	Mon Mar 29 06:19:04 2010	(r45269)
@@ -3,12 +3,9 @@
 
 method new(*@wants) {
     self<wants> := ();
-    self<wants>.unshift(
-        ProfTest::Want::Any.new()
-    );
     for @wants -> $want {
         self<wants>.push($want);
-        pir::say("pushed a thing:"~$want.get_str);
+        self.say("pushed a thing:"~$want.get_str);
     }
     self<wants>.push(
         ProfTest::Want::Goal.new()
@@ -21,31 +18,62 @@
     my @backtracks := ();
     my $line_idx   := 0;
     my $want_idx   := 0;
+    my $start_line := 0;
+    my $max_line   := +$profile.profile_array;
 
     my $curr_line;
     my $curr_want;
 
-    while (11) {
+    while ($line_idx < $max_line) {
 
         $curr_line := $profile.profile_array[$line_idx];
         $curr_want := self<wants>[$want_idx];
-        pir::say("current want: "~$curr_want.get_str);
+        self.say("current want: "~$curr_want.get_str);
+        self.say("current line: "~ ~$curr_line);
 
         if $curr_want.goal {
+            self.say("SUCCESS\n");
             return 1;
         }
         elsif ($curr_want.accepts($curr_line)) {
 
-            @backtracks.push( [$line_idx+1, $want_idx] );
+            self.say("ACCEPTED");
             $line_idx++;
+            # +0 is a workaround for crappy lvalue semantics
+            @backtracks.push( [$line_idx+0, $want_idx+0] );
+            self.say("saving line $line_idx, want $want_idx");
+            self.say("now have "~ ~@backtracks ~ " elements in the stack");
             $want_idx++;
         }
         else {
-            if !@backtracks {
+            self.say("REJECTED");
+            if !@backtracks && $start_line == $max_line {
+                self.say("FAILURE\n");
                 return 0;
             }
-            ($curr_want, $curr_line) := @backtracks.pop;
+            elsif !@backtracks {
+                $start_line++;
+                $line_idx := $start_line+0;
+                self.say("FAILURE: restarting at $line_idx\n");
+            }
+            else {
+                my @a := @backtracks.pop;
+                $line_idx := @a[0];
+                $want_idx := @a[1];
+                self.say("backtracking to line $line_idx, want $want_idx");
+                self.say("now have "~ ~@backtracks ~ " elements in the stack");
+            }
         }
+        self.say('');
     }
 }
 
+method say($str) {
+    if self<debugging> {
+        pir::say($str);
+    }
+}
+
+method debugging($i) {
+    self<debugging> := $i+0;
+}

Modified: branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp
==============================================================================
--- branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp	Mon Mar 29 05:39:37 2010	(r45268)
+++ branches/profiling_testing/runtime/parrot/library/ProfTest/Want.nqp	Mon Mar 29 06:19:04 2010	(r45269)
@@ -13,12 +13,6 @@
     %h;
 }
 
-method exhaust($x? = 1) {
-    self<exhausted> := $x;
-}
-
-method exhausted() { self<exhausted>; }
-
 method goal() { 0; }
 
 
@@ -35,9 +29,7 @@
 class ProfTest::Want::Any is ProfTest::Want;
 
 method new(@except?) {
-    self<except>     := @except;
-    self<cursor_pos> := 0;
-    self<exhausted>  := 0;
+    self<except> := @except;
     self;
 }
 
@@ -69,14 +61,12 @@
 
 method new($version?) {
     self<version>   := $version;
-    self<exhausted> := 0;
     self;
 }
 
 method accepts($prof_line) {
     if $prof_line<fixed_line> &&
         $prof_line<fixed_line><line_type> eq 'VERSION' {
-        self.exhaust;
         return 1;
     }
 }
@@ -95,21 +85,17 @@
 class ProfTest::Want::CLI is ProfTest::Want;
 
 method new() { 
-    self<exhausted> := 1;
     self;
 }
 
 method accepts($prof_line) {
     if $prof_line<fixed_line> &&
         $prof_line<fixed_line><line_type> eq 'CLI' {
-        self.exhaust;
         return 1;
     }
 }
 
-method get_str() {
-    "CLI()";
-}
+method get_str() { "CLI()" }
 
 
 
@@ -120,14 +106,11 @@
 method accepts($prof_line) {
     if $prof_line<fixed_line> &&
         $prof_line<fixed_line><line_type> eq 'END_OF_RUNLOOP' {
-        self.exhaust;
         return 1;
     }
 }
 
-method get_str() {
-    'EndOfRunloop()';
-}
+method get_str() { 'EndOfRunloop()' }
 
 
 
@@ -135,7 +118,6 @@
 
 method new($name, $line?) {
     self<name> := $name;
-    self.exhaust;
     if $line {
         self<line> := $line;
     }
@@ -151,10 +133,9 @@
         if self<line> && self<line> != %variable_data<line> {
             return 0;
         }
-
+        return 1;
     }
-    self.exhaust;
-    return 1;
+    return 0;
 }
 
 method get_str() {
@@ -184,7 +165,6 @@
     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_profile_data($prof_line<variable_line><variable_data>);


More information about the parrot-commits mailing list