[svn:parrot] r45173 - branches/profiling_testing/t/profiling

cotto at svn.parrot.org cotto at svn.parrot.org
Thu Mar 25 04:52:41 UTC 2010


Author: cotto
Date: Thu Mar 25 04:52:40 2010
New Revision: 45173
URL: https://trac.parrot.org/parrot/changeset/45173

Log:
[profiling] add some more profiling test cases

Modified:
   branches/profiling_testing/t/profiling/profiling.t

Modified: branches/profiling_testing/t/profiling/profiling.t
==============================================================================
--- branches/profiling_testing/t/profiling/profiling.t	Thu Mar 25 03:36:18 2010	(r45172)
+++ branches/profiling_testing/t/profiling/profiling.t	Thu Mar 25 04:52:40 2010	(r45173)
@@ -12,25 +12,27 @@
   say "what"
 .end';
 
-my $prof := ProfTest::PirProfile.new($pir);
+my $prof := ProfTest::PIRProfile.new($pir);
 
 #Does the profile have a version string?
-my $matcher := ProfTest::Matcher.new();
-$matcher.push( ProfTest::Want::Version() ): #use count=1 by default
-
+my $matcher := ProfTest::Matcher.new(
+    ProfTest::Want::Version.new(),
+);
 
 ok( $matcher.matches($prof), "profile has a version number");
 
 #Does the profile have a CLI invocation?
-$matcher := ProfTest::Matcher.new();
-$matcher.push( ProfTest::Want::CLI() );
+$matcher := ProfTest::Matcher.new(
+    ProfTest::Want::CLI.new()
+); 
 
 ok( $matcher.matches($prof), "profile contains a CLI string");
 
 
 #Does the profile have a 'say' op somewhere?
-$matcher := ProfTest::Matcher.new();
-$matcher.push( ProfTest::Want::Op( 'say' ));
+$matcher := ProfTest::Matcher.new(
+    ProfTest::Want::Op.new( :op('say') ));
+);
 
 ok( $matcher.matches($prof), "profile has a say op");
 
@@ -45,15 +47,83 @@
 ok( $matcher.matches($prof), "profile shows 'say' inside main sub");
 
 
-#Does the profile show a 'say' op on line 2?
-$match := ProfTest::Matcher.new();
-$matcher.push (ProfTest::Want::Op.new( :count(1), :op('say'), :line('2')));
+$pir_code :=
+".sub first :main
+  .local int i
+  i = 0
+  'second'()
+  inc i
+.end
+
+.sub second
+  .local pmc p
+  p = new ['Interger']
+  'third'()
+  p = 1
+.end
+
+.sub third
+  say 'in third'
+.end";
 
-ok( $matcher.matches($prof), "profile shows say on the correct line");
+$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')),
+);
 
+ok( $matcher.matches($prof), "profile properly reflects normal control flow");
 
 
 #test: main calls foo, foo tailcalls bar, bar returns to main
+$pir_code :=
+".sub first :main
+  .local int i
+  i = 'foo'(9)
+.end
+
+.sub foo
+  .param int i
+  i = i * i
+  .tailcall bar(i)
+.end
+
+.sub bar
+  .param int i
+  i = i + 2
+  .return (i)
+.end";
+
+$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')),
+);
+
+ok( $matcher.matches($prof), "profile properly reflects tailcall control flow");
+
+
+#Does the profile show a 'say' op on line 2?
+$matcher := ProfTest::Matcher.new(
+    ProfTest::Want::Op.new( :op('say'), :line('2')),
+);
+
+ok( $matcher.matches($prof), "profile shows say on the correct line");
+
 
 my $nqp_code := '
 main();
@@ -61,10 +131,10 @@
     pir:say("nqp");
 }';
 
-$prof := ProfTest::NQPProfile.new($nqp_code);
+$prof := ProfTest::NQPProfile.new($nqp_code, :annotations(1));
 
 $matcher := ProfTest::Matcher.new();
-$matcher.push( ProfTest::Want::CS.new( :ns('*main') ) ); #matches parrot::foo::main
+$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') ) );
 


More information about the parrot-commits mailing list