t/50expect.t

   1 #!/usr/bin/env perl
   2
   3 BEGIN {
   4     eval 'use Test::Expect';
   5     if ($@) {
   6         print "# requires Test::Expect\n1..1\nok 1\n";
   7         exit 0;
   8     } else {
   9         eval 'use Test::Simple tests => 34';
  10     }
  11 }
  12
  13 use FindBin '$Bin';
  14 use Sepia;
  15 use Sepia::Xref;
  16
  17 expect_run
  18     command => "$^X -Mblib -MSepia -MSepia::Xref -e Sepia::repl",
  19     prompt => [-re => 'main @[^>]*> '],
  20     quit => ',quit';
  21 expect_handle()->log_file('/tmp/b') if $ENV{USER} eq 'seano';
  22
  23 expect ",help",
  24 q!REPL commands (prefixed with ','):
  25     break [F:N [E]]    Set a breakpoint in F at line N (or at current
  26                        position), enabled if E evalutes to true.
  27     cd DIR             Change directory to DIR
  28     debug [0|1]        Enable or disable debugging.
  29     delete             Delete current breakpoint.
  30     format [dumper|dump|yaml|plain]
  31                        Set output formatter (default: dumper)
  32     help               Display this message
  33     lsbreak            List breakpoints.
  34     methods X [RE]     List methods for reference or package X,
  35                        matching optional pattern RE.
  36
  37     package PACKAGE    Set evaluation package to PACKAGE
  38     quit               Quit the REPL
  39     reload             Reload Sepia.pm and relaunch the REPL.
  40     shell CMD ...      Run CMD in the shell.
  41     strict [0|1]       Turn 'use strict' mode on or off
  42     wantarray [0|1]    Set or toggle evaluation context
  43     who PACKAGE [RE]   List variables and subs in PACKAGE matching optional
  44                        pattern RE.!
  45     if 0;
  46
  47 expect_send ",wh Sepia::Xref xref";
  48 expect_like qr/xref \s+ xref_definitions \s+ xref_main \s+ xref_cv \s+ xref_exclude \s+ xref_object \s* /x;
  49
  50 expect_send '{ package A; sub a {}; package X; @ISA = qw(A); sub x {} };';
  51 expect ",wh X", '@ISA x', 'package list';
  52 expect ",me X", 'a x', 'methods 1';
  53
  54 expect '$x = bless {}, X;', '$x = bless {}, X;'; # XXX: stupid expect.
  55 expect ',me $x', ",me \$x\na x", 'methods 2';    # XXX: stupid expect.
  56
  57 ######################################################################
  58 ## Debugger
  59 expect ',lsb', '';
  60 expect_send ',debug 1';
  61 expect_send "do '$Bin/testy.pl';", 'get testy';
  62
  63 expect 'fib1 10', '55', 'plain fib';
  64 expect ',br testy.pl:6', "break testy.pl:6 if 1", 'break?';
  65 expect_send 'fib1 10';
  66 expect_like qr|_<$Bin/testy.pl:6>|, 'break in fib';
  67 # XXX AGAIN STUPID EXPECT!
  68 expect '$n = 3', "\$n = 3\n3", 'munge lexicals';
  69 expect ',in',
  70 '[3] DB::DB:
  71         $n = \3', 'munged';
  72 expect ',del', '';
  73 expect ',con', '2', 'return from fib';
  74 expect_send 'fib2 10', 'bad fib';
  75 expect_like qr/_<$Bin\/testy.pl:12>/;
  76 expect_send ',q', 'quit';
  77 # expect_like qr/_<$Bin\/testy.pl:12>/;
  78 expect_like qr/error: asdf/, 'saw die message';
  79
  80 <<'EOS';
  81 ,help
  82 ,wh Sepia::Xref xref
  83 { package A; sub a {}; package X; @ISA = qw(A); sub x {} };
  84 ,wh X
  85 ,me X
  86 $x = bless {}, X;
  87 ,me $x
  88 ,lsb
  89 ,debug 1
  90 do 'testy.pl';
  91 fib1 10
  92 ,br testy.pl:6
  93 fib1 10
  94 $n = 3
  95 ,in
  96 ,del
  97 ,con
  98 fib2 10
  99 ,q
 100 EOS