t/tools/parrot_debugger.t

   1 #! perl
   2 # Copyright (C) 2007-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/tools/parrot_debugger.t - test the Parrot Debugger
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/tools/parrot_debugger.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the C<parrot_debugger> tool by providing it with a number of source
  16 files, and running through it with various commands.
  17
  18 We never actually check the I<full> output of parrot_debugger.  We simply check
  19 several smaller components to avoid a test file that is far too unwieldy.
  20
  21
  22 =head1 REQUIREMENTS
  23
  24 This test script requires you to build parrot_debugger, by typing
  25 "make parrot_utils" (using a suitable make tool for your platform).
  26 If this requirement has not been met, all tests will be skipped.
  27
  28 =cut
  29
  30 use strict;
  31 use warnings;
  32 use lib qw(lib);
  33
  34 use Test::More;
  35 use IO::File ();
  36 use Parrot::Config;
  37 use File::Spec;
  38
  39 my $path_to_pdb;
  40
  41 BEGIN {
  42     $path_to_pdb = File::Spec->catfile( ".", "parrot_debugger" );
  43     my $exefile = $path_to_pdb . $PConfig{exe};
  44     unless ( -f $exefile ) {
  45         plan skip_all => "parrot_debugger hasn't been built. Run make parrot_utils";
  46         exit(0);
  47     }
  48 }
  49
  50 my $tests = 0;
  51
  52 pdb_output_like( <<PIR, "pir", "help", qr/List of commands:/, 'help page');
  53 .sub main :main
  54     \$N3 = 3.14159
  55     print \$N3
  56     print "\\n"
  57 .end
  58 PIR
  59 pdb_output_like( <<PIR, "pir", "r", qr/3\.14159/, 'running the program (pir)');
  60 .sub main :main
  61     \$N3 = 3.14159
  62     print \$N3
  63     print "\\n"
  64 .end
  65 PIR
  66 pdb_output_like( <<PASM, "pasm", "run", qr/42/, 'running the program (long,pasm)');
  67     set I1,42
  68     print I1
  69     print "\\n"
  70 PASM
  71 pdb_output_like( <<PASM, "pasm", "r", qr/42/, 'running the program (pasm)');
  72     set I1,42
  73     print I1
  74     print "\\n"
  75 PASM
  76 pdb_output_like( <<PASM, "pasm", "n", qr/one more time/, 'next instruction (pasm)');
  77     print "one more time\\n"
  78 PASM
  79 pdb_output_like( <<PASM, "pasm", "next", qr/one more time/, 'next instruction (long,pasm)');
  80     print "one more time\\n"
  81 PASM
  82 pdb_output_like( <<PIR, "pir", "n", qr/one more time/, 'next instruction (pir)');
  83 .sub main :main
  84     print "one more time\\n"
  85 .end
  86 PIR
  87 pdb_output_like( <<PIR, "pir", "next", qr/one more time/, 'next instruction (long,pir)');
  88 .sub main :main
  89     print "one more time\\n"
  90 .end
  91 PIR
  92 pdb_output_like( <<PIR, "pir", "s", qr/current instr.: 'main'/, 'show stack (pir)');
  93 .sub main :main
  94     \$I1 = 242
  95 .end
  96 PIR
  97 pdb_output_like( <<PIR, "pir", "stack", qr/current instr.: 'main'/, 'show stack (long,pir)');
  98 .sub main :main
  99     \$I1 = 242
 100 .end
 101 PIR
 102 pdb_output_like( <<PASM, "pasm", "s", qr/current instr.: '\(null\)'/, 'show stack (pasm)');
 103     set I1, 242
 104 PASM
 105 pdb_output_like( <<PASM, "pasm", "info", qr/Total memory allocated =/, 'info (pasm)');
 106     set I1, 242
 107 PASM
 108 pdb_output_like( <<PASM, "pasm", "b", qr/Breakpoint 1 at.*pos 0/, 'set breakpoint');
 109     set I1, 242
 110 PASM
 111 pdb_output_like( <<PASM, "pasm", "b\nb\nL", qr/Breakpoint 1 at pos 0\nBreakpoint 2 at pos 0/, 'list breakpoints');
 112     set I1, 242
 113 PASM
 114
 115 pdb_output_like( <<PIR, "pir", "b\nb\nL", qr/Breakpoint 1 at pos 0\nBreakpoint 2 at pos 0/, 'list breakpoints (pir)');
 116 .sub main :main
 117     \$I1 = 242
 118 .end
 119 PIR
 120
 121 pdb_output_like( <<PASM, "pasm", "t", qr/set I0, 242/, 'trace');
 122     set I0, 242
 123 PASM
 124
 125 pdb_output_like( <<PIR, "pir", "t", qr/set I0, 242/, 'trace (pir)');
 126 .sub main :main
 127     \$I0 = 242
 128 .end
 129 PIR
 130
 131 pdb_output_like( <<PASM, "pasm", "t 2", qr/\d+ set I0, 242\s*I0=-?\d+\s*\d+ set I1, 1982/, 'trace multiple statements');
 132     set I0, 242
 133     set I1, 1982
 134 PASM
 135
 136 pdb_output_like( <<PIR, "pir", "t 2", qr/\d+ set I0, 242\s*I0=-?\d+\s*\d+ set I1, 1982/, 'trace multiple statements (pir)');
 137 .sub main :main
 138     \$I0 = 242
 139     \$I1 = 1982
 140 .end
 141 PIR
 142
 143 pdb_output_like( <<PASM, "pasm", "t\np I0", qr/^242/m, 'print an integer register');
 144     set I0, 242
 145 PASM
 146
 147 pdb_output_like( <<PIR, "pir", "t\np I0", qr/^242/m, 'print an integer register (pir)');
 148 .sub main :main
 149     \$I0 = 242
 150 .end
 151 PIR
 152
 153 pdb_output_like( <<PASM, "pasm", "t\np N0", qr/^3.14159/m, 'print a numeric register');
 154     set N0, 3.14159
 155 PASM
 156
 157 pdb_output_like( <<PIR, "pir", "t\np N0", qr/^3.14159/m, 'print a numeric register (pir)');
 158 .sub main :main
 159     \$N0 = 3.14159
 160 .end
 161 PIR
 162
 163 pdb_output_like( <<PASM, "pasm", "t\np P0", qr/^ResizablePMCArray/m, 'print a PMC register');
 164     new P0, 'ResizablePMCArray'
 165 PASM
 166
 167 pdb_output_like( <<PIR, "pir", "t\np P0", qr/^ResizablePMCArray=PMC/m, 'print a PMC register (pir)');
 168 .sub main :main
 169     \$P0 = new 'ResizablePMCArray'
 170 .end
 171 PIR
 172
 173 pdb_output_like( <<PASM, "pasm", "t\np S0", qr/^ceiling cat/m, 'print a string register');
 174     set S0, "ceiling cat"
 175 PASM
 176
 177 pdb_output_like( <<PIR, "pir", "t\np S0", qr/^ceiling cat/m, 'print a string register (pir)');
 178 .sub main :main
 179     \$S0 = "ceiling cat"
 180 .end
 181 PIR
 182
 183 pdb_output_like( <<PASM, "pasm", "t 2\np I", qr/I0 = 242\s*I1 = 1982/, 'print all integer registers');
 184     set I0, 242
 185     set I1, 1982
 186 PASM
 187
 188 pdb_output_like( <<PIR, "pir","t 2\np I", qr/I0 = 242\s*I1 = 1982/, 'print all integer registers (pir)');
 189 .sub main :main
 190     \$I0 = 242
 191     \$I1 = 1982
 192 .end
 193 PIR
 194
 195 pdb_output_like( <<PASM, "pasm", "b\n d 1", qr/Breakpoint 1 deleted/, 'Delete a breakpoint');
 196     set I0, 242
 197 PASM
 198
 199 pdb_output_like( <<PIR, "pir", "b\nd 1", qr/Breakpoint 1 deleted/, 'Delete a breakpoint (pir)');
 200 .sub main :main
 201     \$I0 = 242
 202 .end
 203 PIR
 204
 205 pdb_output_like( <<PIR, "pir", "l", qr/\.sub main :main/, 'list source');
 206 .sub main :main
 207     \$I0 = 242
 208 .end
 209 PIR
 210
 211 pdb_output_like( <<PIR, "pir", "l 2", qr/N4 = 6.28/, 'list source with start line');
 212 .sub main :main
 213     \$N3 = 3.14
 214     \$N4 = 6.28
 215     print "\\n"
 216 .end
 217 PIR
 218
 219 pdb_output_like( <<PIR, "pir", "d 42", qr/No breakpoint number 42/, 'delete invalid breakpoint');
 220 .sub main :main
 221     \$I0 = 242
 222 .end
 223 PIR
 224
 225 TODO: {
 226
 227 local $TODO = 'eval support functions deprecated, TT #872, pending eval reworking';
 228
 229 pdb_output_like( <<PIR, "pir", "e ", qr/Must give a command to eval/, 'eval nothing');
 230 .sub main :main
 231     \$I0 = 242
 232 .end
 233 PIR
 234
 235 }
 236
 237 pdb_output_like( <<PIR, "pir", "t\na I0 17", qr/I0 = 17/, 'assign to an integer register');
 238 .sub main :main
 239     \$I0 = 242
 240 .end
 241 PIR
 242
 243 pdb_output_like( <<PIR, "pir", "t\na i0 17", qr/I0 = 17/, 'assign to an integer register (lowercase)');
 244 .sub main :main
 245     \$I0 = 242
 246 .end
 247 PIR
 248
 249 pdb_output_like( <<PIR, "pir", "a Z0 42", qr/Invalid register type Z/, 'assign to an invalid register');
 250 .sub main :main
 251     \$I0 = 242
 252 .end
 253 PIR
 254
 255 pdb_output_like( <<PIR, "pir", "a foo", qr/Must give a register number and value to assign/, 'invalid assignment command');
 256 .sub main :main
 257     \$I0 = 242
 258 .end
 259 PIR
 260
 261 pdb_output_like( <<PIR, "pir", "t\na N0 3.14", qr/N0 = 3.14/, 'assign to a numeric register');
 262 .sub main :main
 263     \$N0 = 9.99
 264 .end
 265 PIR
 266
 267 pdb_output_like( <<PIR, "pir", "t\np S", qr/S0 = foobar/, 'print string registers');
 268 .sub main :main
 269     \$S0 = "foobar"
 270 .end
 271 PIR
 272
 273 pdb_output_like( <<PIR, "pir", "t\na S0 foobar", qr/S0 = no such register/, 'print string registers when none exist');
 274 .sub main :main
 275     new \$P0, 'ResizableIntegerArray'
 276 .end
 277 PIR
 278
 279 pdb_output_like( <<PIR, "pir", "r", qr/great job!/, 'run code');
 280 .sub main :main
 281     print "great job!"
 282 .end
 283 PIR
 284
 285 TODO: {
 286
 287 local $TODO = 'arguments do not seem to populate $P0';
 288 pdb_output_like( <<PIR, "pir", "r gomer", qr/gomer/, 'run code with args');
 289 .sub main :main
 290     print \$P0
 291 .end
 292 PIR
 293
 294 }
 295
 296 pdb_output_like( <<PIR, "pir", "t\nw I0 == 2\nt", qr/Adding watchpoint/, 'watchpoint');
 297 .sub main :main
 298     \$I0 = 1
 299     \$I0 = 2
 300     \$I0 = 3
 301 .end
 302 PIR
 303
 304 BEGIN { $tests += 45 }
 305
 306 BEGIN { plan tests => $tests; }
 307
 308 =head1 HELPER SUBROUTINES
 309
 310 =head2 pdb_output_like
 311
 312     pdb_output_like(<<PASM, "pasm", 'r', "some output", "running $file");
 313
 314 Takes 4 arguments: a file to run, the filename-extension of the file
 315 (probably "pir" or "pasm"), the command or commands to provide to
 316 parrot_debugger as script file, and a regex string to match within
 317 parrot_debugger's output.
 318
 319 =cut
 320
 321 my $testno = 0;
 322
 323 sub pdb_output_like {
 324     my ( $file, $ext, $input, $check, $diag ) = @_;
 325     $testno++;
 326     my $codefn   = "$0.$testno.$ext";
 327     my $stdinfn  = "$0.$testno.stdin";
 328     my $stdoutfn = "$0.$testno.stdout";
 329     my $f        = IO::File->new(">$codefn");
 330     $f->print($file);
 331     $f->close();
 332     $f = IO::File->new(">$stdinfn");
 333     $f->print($input);
 334     $f->print("\nquit\n");
 335     $f->close();
 336     system("$path_to_pdb --script $stdinfn $codefn >$stdoutfn 2>&1");
 337     $f = IO::File->new($stdoutfn);
 338
 339     my $output = join( '', <$f> );
 340
 341     local $Test::Builder::Level = $Test::Builder::Level + 1;
 342     unlink ($codefn, $stdinfn, $stdoutfn);
 343     like( $output, $check, $diag );
 344 }
 345
 346 =head1 TODO
 347
 348 =over 4
 349
 350 =item
 351
 352 Flesh it out.  This is a bare bones proof of concept.
 353 Add tests for all of the commands.
 354
 355 =back
 356
 357 =cut
 358
 359 # Local Variables:
 360 #   mode: cperl
 361 #   cperl-indent-level: 4
 362 #   fill-column: 100
 363 # End:
 364 # vim: expandtab shiftwidth=4: