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 if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
136 $b = join ',', sort split /,/, $b;
138 print "# [$a] vs [$b]\nnot " if $a ne $b;
141 print "ok $test # skipped: one or more static extensions\n"; $test++;
145 print "# use5005threads: test $test skipped\n";
147 $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
148 if (ord('A') != 193) { # ASCIIish
149 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
151 else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
152 print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
159 my $foo = $deparse->coderef2text(sub { { 234; }});
160 # Constants don't get optimised here.
161 print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
163 $foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
164 print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm;