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/-uWin32,// if $^O eq 'MSWin32';
130 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
131 $a =~ s/-uCwd,// if $^O eq 'cygwin';
132 if ($Config{static_ext} eq ' ') {
133 $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
134 . '-umain,-uwarnings';
135 print "# [$a] vs [$b]\nnot " if $a ne $b;
138 print "ok $test # skipped: one or more static extensions\n"; $test++;
142 print "# use5005threads: test $test skipped\n";
144 $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
145 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;