X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2Fb.t;h=1f7dc14884e58568adc318bfcff15e06aaa9ff76;hb=569bd3158af2276a406770e3d68e76b7da59b730;hp=663ea55fc5385f923bf2f6c158ac357506c3983a;hpb=5fb4d82024edc02e494307d4400683f29b2c718d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/lib/b.t b/t/lib/b.t
index 663ea55..1f7dc14 100755
--- a/t/lib/b.t
+++ b/t/lib/b.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 $|  = 1;
@@ -10,7 +10,7 @@ use warnings;
 use strict;
 use Config;
 
-print "1..10\n";
+print "1..17\n";
 
 my $test = 1;
 
@@ -30,37 +30,72 @@ ok;
 print "not " if "{\n    \$test /= 2 if ++\$test;\n}" ne
                     $deparse->coderef2text(sub {++$test and $test/=2;});
 ok;
+{
+my $a = <<'EOF';
+{
+    $test = sub : lvalue {
+        my $x;
+    }
+    ;
+}
+EOF
+chomp $a;
+print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a;
+ok;
+
+$a =~ s/lvalue/method/;
+print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
+ok;
+
+$a =~ s/method/locked method/;
+print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
+                                     ne $a;
+ok;
+}
+
+print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42;
+ok;
+
+use constant 'c', 'stuff';
+print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
+ok;
+
+# XXX ToDo - constsub that returns a reference
+#use constant cr => ['hello'];
+#my $string = "sub " . $deparse->coderef2text(\&cr);
+#my $val = (eval $string)->();
+#print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
+#ok;
 
-my $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`;
+my $a;
+my $Is_VMS = $^O eq 'VMS';
+$a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
 $a =~ s/-e syntax OK\n//g;
+$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
+$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
 $b = <<'EOF';
 
 LINE: while (defined($_ = <ARGV>)) {
     chomp $_;
     @F = split(/\s+/, $_, 0);
-    '???'
-}
-continue {
-    '???'
+    '???';
 }
 
 EOF
 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
 ok;
 
-#6
-$a = `$^X -I../lib -MO=Debug -e 1 2>&1`;
+$a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
 print "not " unless $a =~
 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
 ok;
 
-#7
-$a = `$^X -I../lib -MO=Terse -e 1 2>&1`;
+$a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
 print "not " unless $a =~
-/\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s;
+/\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s;
 ok;
 
-$a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`;
+$a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
 $a =~ s/\(0x[^)]+\)//g;
 $a =~ s/\[[^\]]+\]//g;
 $a =~ s/-e syntax OK//;
@@ -69,25 +104,63 @@ $a =~ s/\s+/ /g;
 $a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
 $a =~ s/^\s+//;
 $a =~ s/\s+$//;
-$b=<<EOF;
+my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
+if ($is_thread) {
+    $b=<<EOF;
+leave enter nextstate label leaveloop enterloop null and defined null
+threadsv readline gv lineseq nextstate aassign null pushmark split pushre
+threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
+EOF
+} else {
+    $b=<<EOF;
 leave enter nextstate label leaveloop enterloop null and defined null
 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
-null gvsv const null pushmark rvav gv nextstate subst const unstack
-nextstate
+null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
 EOF
+}
 $b=~s/\n/ /g;$b=~s/\s+/ /g;
 $b =~ s/\s+$//;
-print "# [$a] vs [$b]\nnot " if $a ne $b;
+print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
 ok;
 
-chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`);
+chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
 $a = join ',', sort split /,/, $a;
-$a =~ s/-uWin32,//;
-$b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
-   . '-umain,-uwarnings';
-print "# [$a] vs [$b]\nnot " if $a ne $b;
+$a =~ s/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
+$a =~ s/-uWin32,// if $^O eq 'MSWin32';
+$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
+$a =~ s/-uCwd,// if $^O eq 'cygwin';
+if ($Config{static_ext} eq ' ') {
+  $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
+     . '-umain,-ustrict,-uwarnings';
+  if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
+      $b = join ',', sort split /,/, $b;
+  }
+  print "# [$a] vs [$b]\nnot " if $a ne $b;
+  ok;
+} else {
+  print "ok $test # skipped: one or more static extensions\n"; $test++;
+}
+
+if ($is_thread) {
+    print "# use5005threads: test $test skipped\n";
+} else {
+    $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
+    if (ord('A') != 193) { # ASCIIish
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+    } 
+    else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
+    }
+}
 ok;
 
-$a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`;
-print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+# Bug 20001204.07
+{
+my $foo = $deparse->coderef2text(sub { { 234; }});
+# Constants don't get optimised here.
+print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
 ok;
+$foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
+print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm; 
+ok;
+}