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
  27 print "1..3\n";
  28
  29 my $test = 1;
  30
  31 sub ok { print "ok $test\n"; $test++ }
  32
  33
  34 my $a;
  35 my $Is_VMS = $^O eq 'VMS';
  36 my $Is_MacOS = $^O eq 'MacOS';
  37
  38 my $path = join " ", map { qq["-I$_"] } @INC;
  39 my $redir = $Is_MacOS ? "" : "2>&1";
  40
  41 $a = `$^X $path "-MO=Debug" -e 1 $redir`;
  42 print "not " unless $a =~
  43 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
  44 ok;
  45
  46
  47 $a = `$^X $path "-MO=Terse" -e 1 $redir`;
  48 print "not " unless $a =~
  49 /\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s;
  50 ok;
  51
  52 $a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
  53 $a =~ s/\(0x[^)]+\)//g;
  54 $a =~ s/\[[^\]]+\]//g;
  55 $a =~ s/-e syntax OK//;
  56 $a =~ s/[^a-z ]+//g;
  57 $a =~ s/\s+/ /g;
  58 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
  59 $a =~ s/^\s+//;
  60 $a =~ s/\s+$//;
  61 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
  62 if ($is_thread) {
  63     $b=<<EOF;
  64 leave enter nextstate label leaveloop enterloop null and defined null
  65 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
  66 threadsv const null pushmark rvav gv nextstate subst const unstack
  67 EOF
  68 } else {
  69     $b=<<EOF;
  70 leave enter nextstate label leaveloop enterloop null and defined null
  71 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
  72 null gvsv const null pushmark rvav gv nextstate subst const unstack
  73 EOF
  74 }
  75 $b=~s/\n/ /g;$b=~s/\s+/ /g;
  76 $b =~ s/\s+$//;
  77 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
  78 ok;
  79