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);
86 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
89 $a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
90 print "not " unless $a =~
91 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
94 $a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
95 print "not " unless $a =~
96 /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
99 $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
100 $a =~ s/\(0x[^)]+\)//g;
101 $a =~ s/\[[^\]]+\]//g;
102 $a =~ s/-e syntax OK//;
105 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
108 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
111 leave enter nextstate label leaveloop enterloop null and defined null
112 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
113 threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
117 leave enter nextstate label leaveloop enterloop null and defined null
118 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
119 null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
122 $b=~s/\n/ /g;$b=~s/\s+/ /g;
124 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
127 chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
128 $a = join ',', sort split /,/, $a;
129 $a =~ s/-uperlio(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
130 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
131 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
132 $a =~ s/-uCwd,// if $^O eq 'cygwin';
133 if ($Config{static_ext} eq ' ') {
134 $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
135 . '-umain,-uwarnings';
136 print "# [$a] vs [$b]\nnot " if $a ne $b;
139 print "ok $test # skipped: one or more static extensions\n"; $test++;
143 print "# use5005threads: test $test skipped\n";
145 $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
146 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;