17 sub ok { print "ok $test\n"; $test++ }
20 my $deparse = B::Deparse->new() or print "not ";
23 print "not " if "{\n 1;\n}" ne $deparse->coderef2text(sub {1});
26 print "not " if "{\n '???';\n 2;\n}" ne
27 $deparse->coderef2text(sub {1;2});
30 print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne
31 $deparse->coderef2text(sub {++$test and $test/=2;});
36 $test = sub : lvalue {
43 print "not " if $deparse->coderef2text(sub{$test = sub : lvalue { 1 }}) ne $a;
46 $a =~ s/lvalue/method/;
47 print "not " if $deparse->coderef2text(sub{$test = sub : method { 1 }}) ne $a;
50 $a =~ s/method/locked method/;
51 print "not " if $deparse->coderef2text(sub{$test = sub : method locked { 1 }})
56 print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
59 use constant 'c', 'stuff';
60 print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
63 # XXX ToDo - constsub that returns a reference
64 #use constant cr => ['hello'];
65 #my $string = "sub " . $deparse->coderef2text(\&cr);
66 #my $val = (eval $string)->();
67 #print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
71 my $Is_VMS = $^O eq 'VMS';
72 $a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
73 $a =~ s/-e syntax OK\n//g;
76 LINE: while (defined($_ = <ARGV>)) {
78 @F = split(/\s+/, $_, 0);
83 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
86 $a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
87 print "not " unless $a =~
88 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
91 $a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
92 print "not " unless $a =~
93 /\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s;
96 $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
97 $a =~ s/\(0x[^)]+\)//g;
98 $a =~ s/\[[^\]]+\]//g;
99 $a =~ s/-e syntax OK//;
102 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
105 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
108 leave enter nextstate label leaveloop enterloop null and defined null
109 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
110 threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
114 leave enter nextstate label leaveloop enterloop null and defined null
115 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
116 null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
119 $b=~s/\n/ /g;$b=~s/\s+/ /g;
121 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
124 chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
125 $a = join ',', sort split /,/, $a;
126 $a =~ s/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
127 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
128 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
129 $a =~ s/-uCwd,// if $^O eq 'cygwin';
130 if ($Config{static_ext} eq ' ') {
131 $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
132 . '-umain,-ustrict,-uwarnings';
133 print "# [$a] vs [$b]\nnot " if $a ne $b;
136 print "ok $test # skipped: one or more static extensions\n"; $test++;
140 print "# use5005threads: test $test skipped\n";
142 $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
143 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
149 my $foo = $deparse->coderef2text(sub { { 234; }});
150 # Constants don't get optimised here.
151 print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
153 $foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
154 print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;