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{my $x}}) ne $a;
46 $a =~ s/lvalue/method/;
47 print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
50 $a =~ s/method/locked method/;
51 print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
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;
74 $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
75 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
78 LINE: while (defined($_ = <ARGV>)) {
80 @F = split(/\s+/, $_, 0);
85 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
88 $a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
89 print "not " unless $a =~
90 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
93 $a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
94 print "not " unless $a =~
95 /\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s;
98 $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
99 $a =~ s/\(0x[^)]+\)//g;
100 $a =~ s/\[[^\]]+\]//g;
101 $a =~ s/-e syntax OK//;
104 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
107 my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
110 leave enter nextstate label leaveloop enterloop null and defined null
111 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
112 threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
116 leave enter nextstate label leaveloop enterloop null and defined null
117 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
118 null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
121 $b=~s/\n/ /g;$b=~s/\s+/ /g;
123 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
126 chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
127 $a = join ',', sort split /,/, $a;
128 $a =~ s/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
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,-ustrict,-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 if (ord('A') != 193) { # ASCIIish
146 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
148 else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
149 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
156 my $foo = $deparse->coderef2text(sub { { 234; }});
157 # Constants don't get optimised here.
158 print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
160 $foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
161 print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;