Commit | Line | Data |
---|---|---|
9e01a143 DIM |
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 => 11; | |
28 | use B; | |
29 | use B::Debug; | |
30 | use File::Spec; | |
31 | ||
32 | my $a; | |
33 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; | |
34 | ||
35 | my $path = join " ", map { qq["-I$_"] } (File::Spec->catfile("blib","lib"), @INC); | |
36 | my $redir = $^O =~ /VMS|MSWin32|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 | $a =~ s/\s+nextstate$//; # if $] < 5.008001; # 5.8.0 adds it. 5.8.8 not anymore | |
55 | my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define'; | |
56 | if ($is_thread) { | |
57 | $b=<<EOF; | |
58 | leave enter nextstate label leaveloop enterloop null and defined null | |
59 | threadsv readline gv lineseq nextstate aassign null pushmark split pushre | |
60 | threadsv const null pushmark rvav gv nextstate subst const unstack | |
61 | EOF | |
62 | } elsif ($] >= 5.021005) { | |
63 | $b=<<EOF; | |
64 | leave enter nextstate label leaveloop enterloop null and defined null null | |
65 | gvsv readline gv lineseq nextstate split pushre null | |
66 | gvsv const nextstate subst const unstack | |
67 | EOF | |
68 | } else { | |
69 | $b=<<EOF; | |
70 | leave enter nextstate label leaveloop enterloop null and defined null null | |
71 | gvsv readline gv lineseq nextstate aassign null pushmark split pushre null | |
72 | 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 | $b =~ s/split pushre/split/ if $] >= 5.025006; | |
78 | ||
79 | is($a, $b); | |
80 | ||
81 | like(B::Debug::_printop(B::main_root), qr/LISTOP\s+\[OP_LEAVE\]/); | |
82 | like(B::Debug::_printop(B::main_start), qr/OP\s+\[OP_ENTER\]/); | |
83 | ||
84 | $a = `$X $path "-MO=Debug" -e "B::main_root->debug" $redir`; | |
85 | like($a, qr/op_next\s+0x0/m); | |
86 | $a = `$X $path "-MO=Debug" -e "B::main_start->debug" $redir`; | |
87 | like($a, qr/\[OP_ENTER\]/m); | |
88 | ||
89 | # pass missing FETCHSIZE, fixed with 1.06 | |
90 | my $e = q(BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}};print $a[1]); | |
91 | $a = `$X $path "-MO=Debug" -e"$e" $redir`; | |
92 | unlike($a, qr/locate object method "FETCHSIZE"/m); | |
93 | ||
94 | # NV assertion with CV, fixed with 1.13 | |
95 | my $tmp = "tmp.pl"; | |
96 | open TMP, ">", $tmp; | |
97 | print TMP 'my $p=1;$g=2;sub p($){my $i=1;$i+1};print p(0)+$g;'; | |
98 | close TMP; | |
99 | $a = `$X $path "-MO=Debug" $tmp $redir`; | |
100 | ok(! $?); | |
101 | unlike($a, qr/assertion "SvTYPE(sv) != SVt_PVCV" failed.*function: S_sv_2iuv_common/m); | |
102 | unlike($a, qr/Use of uninitialized value in print/m); | |
103 | ||
104 | END { unlink $tmp if $tmp; } |