t/run/switchd.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = qw(../lib lib);
   6 }
   7
   8 BEGIN { require "./test.pl"; }
   9
  10 # This test depends on t/lib/Devel/switchd*.pm.
  11
  12 plan(tests => 5);
  13
  14 my $r;
  15
  16 my $filename = tempfile();
  17 SKIP: {
  18         open my $f, ">$filename"
  19             or skip( "Can't write temp file $filename: $!" );
  20         print $f <<'__SWDTEST__';
  21 package Bar;
  22 sub bar { $_[0] * $_[0] }
  23 package Foo;
  24 sub foo {
  25   my $s;
  26   $s += Bar::bar($_) for 1..$_[0];
  27 }
  28 package main;
  29 Foo::foo(3);
  30 __SWDTEST__
  31     close $f;
  32     $| = 1; # Unbufferize.
  33     $r = runperl(
  34                  switches => [ '-Ilib', '-f', '-d:switchd' ],
  35                  progfile => $filename,
  36                  args => ['3'],
  37                 );
  38     like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
  39     $r = runperl(
  40                  switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
  41                  progfile => $filename,
  42                  args => ['4'],
  43                 );
  44     like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
  45     $r = runperl(
  46                  switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
  47                  progfile => $filename,
  48                  args => ['4'],
  49                 );
  50     like($r, qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
  51 }
  52
  53 # [perl #71806]
  54 cmp_ok(
  55   runperl(       # less is useful for something :-)
  56    switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
  57    progs    => [
  58     '#!perl -d:_',
  59     'sub DB::DB{} print scalar @{q/_</.__FILE__}',
  60    ],
  61   ),
  62  '>',
  63   0,
  64  'The debugger can see the lines of the main program under #!perl -d',
  65 );
  66
  67 # [perl #48332]
  68 like(
  69   runperl(
  70    switches => [ '-Ilib', '-d:switchd_empty' ],
  71    progs    => [
  72     'sub foo { print qq _1\n_ }',
  73     '*old_foo = \&foo;',
  74     '*foo = sub { print qq _2\n_ };',
  75     'old_foo(); foo();',
  76    ],
  77   ),
  78   qr "1\r?\n2\r?\n",
  79  'Subroutine redefinition works in the debugger [perl #48332]',
  80 );