ext/B/t/debug.t

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