ext/B/t/debug.t

   1 #!./perl
   2
   3 BEGIN {
   4     delete $ENV{PERL_DL_NONLAZY} if $] < 5.005_58; #Perl_byterun problem
   5     if ($ENV{PERL_CORE}){
   6         chdir('t') if -d 't';
   7         if ($^O eq 'MacOS') {
   8             @INC = qw(: ::lib ::macos:lib);
   9         } else {
  10             @INC = '.';
  11             push @INC, '../lib';
  12         }
  13     } else {
  14         unshift @INC, 't';
  15     }
  16     require Config;
  17     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
  18         print "1..0 # Skip -- Perl configured without B module\n";
  19         exit 0;
  20     }
  21 }
  22
  23 $|  = 1;
  24 use warnings;
  25 use strict;
  26 use Config;
  27 use Test::More tests => 7;
  28 use B;
  29 use B::Debug;
  30
  31 my $a;
  32 my $Is_VMS = $^O eq 'VMS';
  33 my $Is_MacOS = $^O eq 'MacOS';
  34
  35 my $path = join " ", map { qq["-I$_"] } @INC;
  36 my $redir = $Is_MacOS ? "" : "2>&1";
  37
  38 $a = `$^X $path "-MO=Debug" -e 1 $redir`;
  39 like($a, qr/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s);
  40
  41
  42 $a = `$^X $path "-MO=Terse" -e 1 $redir`;
  43 like($a, qr/\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s);
  44
  45 $a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
  46 $a =~ s/\(0x[^)]+\)//g;
  47 $a =~ s/\[[^\]]+\]//g;
  48 $a =~ s/-e syntax OK//;
  49 $a =~ s/[^a-z ]+//g;
  50 $a =~ s/\s+/ /g;
  51 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
  52 $a =~ s/^\s+//;
  53 $a =~ s/\s+$//;
  54 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
  55 if ($is_thread) {
  56     $b=<<EOF;
  57 leave enter nextstate label leaveloop enterloop null and defined null
  58 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
  59 threadsv const null pushmark rvav gv nextstate subst const unstack
  60 EOF
  61 } else {
  62     $b=<<EOF;
  63 leave enter nextstate label leaveloop enterloop null and defined null
  64 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
  65 null gvsv const null pushmark rvav gv nextstate subst const unstack
  66 EOF
  67 }
  68 $b=~s/\n/ /g;$b=~s/\s+/ /g;
  69 $b =~ s/\s+$//;
  70 is($a, $b);
  71
  72 like(B::Debug::_printop(B::main_root),  qr/LISTOP\s+\[OP_LEAVE\]/);
  73 like(B::Debug::_printop(B::main_start), qr/OP\s+\[OP_ENTER\]/);
  74
  75 $a = `$^X $path "-MO=Debug" -e "B::main_root->debug" $redir`;
  76 like($a, qr/op_next\s+0x0/m);
  77 $a = `$^X $path "-MO=Debug" -e "B::main_start->debug" $redir`;
  78 like($a, qr/PL_ppaddr\[OP_ENTER\]/m);