Added test for 'list' command but doesn't pass yet. Tried to filter o…

…ut welcome message with a regex but it doesn't quite work.

lib/Parrot/Test/HBDB.pm

@@ -253,6 +253,13 @@ sub _select {
         foreach my $fh (@fh_ready) {
             next unless defined $fh;
 
+            next if <$fh>
+               =~ m|^HBDB: The Honey Bee Debugger
+                    Copyright \(C\) 2001-2011, Parrot Foundation\.
+                    Enter "h" or "help" for help or see docs/hbdb\.pod for further information\.$|x;
+
+            next if <$fh> =~ m|\(hbdb\) .*|;
+
             $$lines .= <$fh>;
 
             #if (fileno $fh  == fileno \*HBDB_STDERR) {

t/tools/hbdb/cmds.t

@@ -28,13 +28,14 @@ use warnings;
 use lib qw(lib);
 
 use Parrot::Config;
-use Parrot::Test::HBDB tests => 2;
+use Parrot::Test::HBDB tests => 3;
 
 my $pir  = join $PConfig{slash}, qw(t tools hbdb testlib hello.pir);
 my $hbdb = Parrot::Test::HBDB->new();
 
 test_bad_cmd();
 test_help_cmd();
+test_list_cmd();
 
 sub test_bad_cmd {
     my $bad_cmd = 'this_is_not_a_command';
@@ -67,6 +68,27 @@ OUTPUT
     $hbdb->cmd_output_like($cmd, $output, 'HBDB: Help command');
 }
 
+sub test_list_cmd {
+    my $cmd = 'list';
+
+    my $output = <<OUTPUT;
+1     #! parrot
+2
+3     .sub 'main' :main
+4         say "Starting at line 4"
+5         say "About to call foo()"
+6         foo()
+7         say "Back in main() at line 7"
+8         say "About to quit"
+9     .end
+10
+OUTPUT
+
+    $hbdb->start($pir, '');
+
+    $hbdb->cmd_output_is($cmd, $output, 'HBDB: List command');
+}
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4