X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2Ft%2Foptree_samples.t;h=d198c59e65529be37606a5ac1aa41159fb33171f;hb=ce5d06123ae0253bf2e33033ffbfba16ce3bb79e;hp=d22eb911d93989bf27abcb00f1f1a9aa94810d81;hpb=498d59dd5e74232ff73ab47a68daf476accc8df1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index d22eb91..d198c59 100644
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -1,13 +1,25 @@
 #!perl
 
 BEGIN {
-    chdir 't';
-    @INC = ('../lib', '../ext/B/t');
-    require './test.pl';
+    if ($ENV{PERL_CORE}){
+	chdir('t') if -d 't';
+	@INC = ('.', '../lib', '../ext/B/t');
+    } else {
+	unshift @INC, 't';
+	push @INC, "../../t";
+    }
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+    # require 'test.pl'; # now done by OptreeCheck
 }
 use OptreeCheck;
-
-plan tests	=> 13;
+use Config;
+plan tests	=> 20;
+SKIP: {
+    skip "no perlio in this build", 20 unless $Config::Config{useperlio};
 
 pass("GENERAL OPTREE EXAMPLES");
 
@@ -18,8 +30,8 @@ checkOptree ( name	=> '-basic sub {if shift print then,else}',
 	      code	=> sub { if (shift) { print "then" }
 				 else       { print "else" }
 			     },
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# B::Concise::compile(CODE(0x81a77b4))
 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->9
 # 1        <;> nextstate(main 426 optree.t:16) v ->2
@@ -67,6 +79,7 @@ checkOptree ( name	=> '-basic (see above, with my $a = shift)',
 				 if ($a) { print "foo" }
 				 else    { print "bar" }
 			     },
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # d  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->d
@@ -92,9 +105,6 @@ checkOptree ( name	=> '-basic (see above, with my $a = shift)',
 # g                    <0> pushmark s ->h
 # h                    <$> const[PV "bar"] s ->i
 EOT_EOT
-# 1  <;> nextstate(main 45 optree.t:23) v
-# 2  <0> padsv[$a:45,46] M/LVINTRO
-# 3  <1> leavesub[1 ref] K/REFC,1
 # d  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->d
 # 1        <;> nextstate(main 428 optree_samples.t:48) v ->2
@@ -125,8 +135,8 @@ checkOptree ( name	=> '-exec sub {if shift print then,else}',
 	      code	=> sub { if (shift) { print "then" }
 				 else       { print "else" }
 			     },
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# B::Concise::compile(CODE(0x81a77b4))
 # 1  <;> nextstate(main 426 optree.t:16) v
 # 2  <#> gv[*_] s
 # 3  <1> rv2av[t2] sKRM/1
@@ -168,6 +178,7 @@ checkOptree ( name	=> '-exec (see above, with my $a = shift)',
 				 if ($a) { print "foo" }
 				 else    { print "bar" }
 			     },
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # 1  <;> nextstate(main 423 optree.t:16) v
 # 2  <#> gv[*_] s
@@ -215,6 +226,7 @@ EONT_EONT
 checkOptree ( name	=> '-exec sub { print (shift) ? "foo" : "bar" }',
 	      code	=> sub { print (shift) ? "foo" : "bar" },
 	      bcopts	=> '-exec',
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # 1  <;> nextstate(main 428 optree.t:31) v
 # 2  <0> pushmark s
@@ -246,13 +258,14 @@ pass ("FOREACH");
 checkOptree ( name	=> '-exec sub { foreach (1..10) {print "foo $_"} }',
 	      code	=> sub { foreach (1..10) {print "foo $_"} },
 	      bcopts	=> '-exec',
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # 1  <;> nextstate(main 443 optree.t:158) v
 # 2  <0> pushmark s
 # 3  <$> const[IV 1] s
 # 4  <$> const[IV 10] s
 # 5  <#> gv[*_] s
-# 6  <{> enteriter(next->d last->g redo->7) lKS
+# 6  <{> enteriter(next->d last->g redo->7) lKS/8
 # e  <0> iter s
 # f  <|> and(other->7) K/1
 # 7      <;> nextstate(main 442 optree.t:158) v
@@ -265,14 +278,13 @@ checkOptree ( name	=> '-exec sub { foreach (1..10) {print "foo $_"} }',
 #            goto e
 # g  <2> leaveloop K/2
 # h  <1> leavesub[1 ref] K/REFC,1
-# '
 EOT_EOT
 # 1  <;> nextstate(main 444 optree_samples.t:182) v
 # 2  <0> pushmark s
 # 3  <$> const(IV 1) s
 # 4  <$> const(IV 10) s
 # 5  <$> gv(*_) s
-# 6  <{> enteriter(next->d last->g redo->7) lKS
+# 6  <{> enteriter(next->d last->g redo->7) lKS/8
 # e  <0> iter s
 # f  <|> and(other->7) K/1
 # 7      <;> nextstate(main 443 optree_samples.t:182) v
@@ -290,13 +302,14 @@ EONT_EONT
 checkOptree ( name	=> '-basic sub { print "foo $_" foreach (1..10) }',
 	      code	=> sub { print "foo $_" foreach (1..10) }, 
 	      bcopts	=> '-basic',
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # h  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->h
 # 1        <;> nextstate(main 445 optree.t:167) v ->2
 # 2        <;> nextstate(main 445 optree.t:167) v ->3
 # g        <2> leaveloop K/2 ->h
-# 7           <{> enteriter(next->d last->g redo->8) lKS ->e
+# 7           <{> enteriter(next->d last->g redo->8) lKS/8 ->e
 # -              <0> ex-pushmark s ->3
 # -              <1> ex-list lK ->6
 # 3                 <0> pushmark s ->4
@@ -322,7 +335,7 @@ EOT_EOT
 # 1        <;> nextstate(main 446 optree_samples.t:192) v ->2
 # 2        <;> nextstate(main 446 optree_samples.t:192) v ->3
 # g        <2> leaveloop K/2 ->h
-# 7           <{> enteriter(next->d last->g redo->8) lKS ->e
+# 7           <{> enteriter(next->d last->g redo->8) lKS/8 ->e
 # -              <0> ex-pushmark s ->3
 # -              <1> ex-list lK ->6
 # 3                 <0> pushmark s ->4
@@ -347,6 +360,7 @@ EONT_EONT
 checkOptree ( name	=> '-exec -e foreach (1..10) {print qq{foo $_}}',
 	      prog	=> 'foreach (1..10) {print qq{foo $_}}',
 	      bcopts	=> '-exec',
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # 1  <0> enter 
 # 2  <;> nextstate(main 2 -e:1) v
@@ -354,7 +368,7 @@ checkOptree ( name	=> '-exec -e foreach (1..10) {print qq{foo $_}}',
 # 4  <$> const[IV 1] s
 # 5  <$> const[IV 10] s
 # 6  <#> gv[*_] s
-# 7  <{> enteriter(next->e last->h redo->8) lKS
+# 7  <{> enteriter(next->e last->h redo->8) lKS/8
 # f  <0> iter s
 # g  <|> and(other->8) vK/1
 # 8      <;> nextstate(main 1 -e:1) v
@@ -374,7 +388,7 @@ EOT_EOT
 # 4  <$> const(IV 1) s
 # 5  <$> const(IV 10) s
 # 6  <$> gv(*_) s
-# 7  <{> enteriter(next->e last->h redo->8) lKS
+# 7  <{> enteriter(next->e last->h redo->8) lKS/8
 # f  <0> iter s
 # g  <|> and(other->8) vK/1
 # 8      <;> nextstate(main 1 -e:1) v
@@ -387,22 +401,20 @@ EOT_EOT
 #            goto f
 # h  <2> leaveloop vK/2
 # i  <@> leave[1 ref] vKP/REFC
-
 EONT_EONT
 
 checkOptree ( name	=> '-exec sub { print "foo $_" foreach (1..10) }',
 	      code	=> sub { print "foo $_" foreach (1..10) }, 
 	      bcopts	=> '-exec',
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# B::Concise::compile(CODE(0x8332b20))
-#            goto -
 # 1  <;> nextstate(main 445 optree.t:167) v
 # 2  <;> nextstate(main 445 optree.t:167) v
 # 3  <0> pushmark s
 # 4  <$> const[IV 1] s
 # 5  <$> const[IV 10] s
 # 6  <#> gv[*_] s
-# 7  <{> enteriter(next->d last->g redo->8) lKS
+# 7  <{> enteriter(next->d last->g redo->8) lKS/8
 # e  <0> iter s
 # f  <|> and(other->8) K/1
 # 8      <0> pushmark s
@@ -421,7 +433,7 @@ EOT_EOT
 # 4  <$> const(IV 1) s
 # 5  <$> const(IV 10) s
 # 6  <$> gv(*_) s
-# 7  <{> enteriter(next->d last->g redo->8) lKS
+# 7  <{> enteriter(next->d last->g redo->8) lKS/8
 # e  <0> iter s
 # f  <|> and(other->8) K/1
 # 8      <0> pushmark s
@@ -435,25 +447,219 @@ EOT_EOT
 # h  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
+pass("GREP: SAMPLES FROM PERLDOC -F GREP");
+
+checkOptree ( name	=> '@foo = grep(!/^\#/, @bar)',
+	      code	=> '@foo = grep(!/^\#/, @bar)',
+	      bcopts	=> '-exec',
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 1  <;> nextstate(main 496 (eval 20):1) v:{
+# 2  <0> pushmark s
+# 3  <0> pushmark s
+# 4  <#> gv[*bar] s
+# 5  <1> rv2av[t4] lKM/1
+# 6  <@> grepstart lK
+# 7  <|> grepwhile(other->8)[t5] lK
+# 8      </> match(/"^#"/) s/RTIME
+# 9      <1> not sK/1
+#            goto 7
+# a  <0> pushmark s
+# b  <#> gv[*foo] s
+# c  <1> rv2av[t2] lKRM*/1
+# d  <2> aassign[t6] KS/COMMON
+# e  <1> leavesub[1 ref] K/REFC,1
+EOT_EOT
+# 1  <;> nextstate(main 496 (eval 20):1) v:{
+# 2  <0> pushmark s
+# 3  <0> pushmark s
+# 4  <$> gv(*bar) s
+# 5  <1> rv2av[t2] lKM/1
+# 6  <@> grepstart lK
+# 7  <|> grepwhile(other->8)[t3] lK
+# 8      </> match(/"^\\#"/) s/RTIME
+# 9      <1> not sK/1
+#            goto 7
+# a  <0> pushmark s
+# b  <$> gv(*foo) s
+# c  <1> rv2av[t1] lKRM*/1
+# d  <2> aassign[t4] KS/COMMON
+# e  <1> leavesub[1 ref] K/REFC,1
+EONT_EONT
+
+
+pass("MAP: SAMPLES FROM PERLDOC -F MAP");
+
+checkOptree ( name	=> '%h = map { getkey($_) => $_ } @a',
+	      code	=> '%h = map { getkey($_) => $_ } @a',
+	      bcopts	=> '-exec',
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 1  <;> nextstate(main 501 (eval 22):1) v:{
+# 2  <0> pushmark s
+# 3  <0> pushmark s
+# 4  <#> gv[*a] s
+# 5  <1> rv2av[t8] lKM/1
+# 6  <@> mapstart lK*
+# 7  <|> mapwhile(other->8)[t9] lK
+# 8      <0> enter l
+# 9      <;> nextstate(main 500 (eval 22):1) v:{
+# a      <0> pushmark s
+# b      <0> pushmark s
+# c      <#> gvsv[*_] s
+# d      <#> gv[*getkey] s/EARLYCV
+# e      <1> entersub[t5] lKS/TARG,1
+# f      <#> gvsv[*_] s
+# g      <@> list lK
+# h      <@> leave lKP
+#            goto 7
+# i  <0> pushmark s
+# j  <#> gv[*h] s
+# k  <1> rv2hv[t2] lKRM*/1
+# l  <2> aassign[t10] KS/COMMON
+# m  <1> leavesub[1 ref] K/REFC,1
+EOT_EOT
+# 1  <;> nextstate(main 501 (eval 22):1) v:{
+# 2  <0> pushmark s
+# 3  <0> pushmark s
+# 4  <$> gv(*a) s
+# 5  <1> rv2av[t3] lKM/1
+# 6  <@> mapstart lK*
+# 7  <|> mapwhile(other->8)[t4] lK
+# 8      <0> enter l
+# 9      <;> nextstate(main 500 (eval 22):1) v:{
+# a      <0> pushmark s
+# b      <0> pushmark s
+# c      <$> gvsv(*_) s
+# d      <$> gv(*getkey) s/EARLYCV
+# e      <1> entersub[t2] lKS/TARG,1
+# f      <$> gvsv(*_) s
+# g      <@> list lK
+# h      <@> leave lKP
+#            goto 7
+# i  <0> pushmark s
+# j  <$> gv(*h) s
+# k  <1> rv2hv[t1] lKRM*/1
+# l  <2> aassign[t5] KS/COMMON
+# m  <1> leavesub[1 ref] K/REFC,1
+EONT_EONT
+
+checkOptree ( name	=> '%h=(); for $_(@a){$h{getkey($_)} = $_}',
+	      code	=> '%h=(); for $_(@a){$h{getkey($_)} = $_}',
+	      bcopts	=> '-exec',
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 1  <;> nextstate(main 505 (eval 24):1) v
+# 2  <0> pushmark s
+# 3  <0> pushmark s
+# 4  <#> gv[*h] s
+# 5  <1> rv2hv[t2] lKRM*/1
+# 6  <2> aassign[t3] vKS
+# 7  <;> nextstate(main 506 (eval 24):1) v:{
+# 8  <0> pushmark sM
+# 9  <#> gv[*a] s
+# a  <1> rv2av[t6] sKRM/1
+# b  <#> gv[*_] s
+# c  <1> rv2gv sKRM/1
+# d  <{> enteriter(next->o last->r redo->e) lKS/8
+# p  <0> iter s
+# q  <|> and(other->e) K/1
+# e      <;> nextstate(main 505 (eval 24):1) v:{
+# f      <#> gvsv[*_] s
+# g      <#> gv[*h] s
+# h      <1> rv2hv sKR/1
+# i      <0> pushmark s
+# j      <#> gvsv[*_] s
+# k      <#> gv[*getkey] s/EARLYCV
+# l      <1> entersub[t10] sKS/TARG,1
+# m      <2> helem sKRM*/2
+# n      <2> sassign vKS/2
+# o      <0> unstack s
+#            goto p
+# r  <2> leaveloop K/2
+# s  <1> leavesub[1 ref] K/REFC,1
+EOT_EOT
+# 1  <;> nextstate(main 505 (eval 24):1) v
+# 2  <0> pushmark s
+# 3  <0> pushmark s
+# 4  <$> gv(*h) s
+# 5  <1> rv2hv[t1] lKRM*/1
+# 6  <2> aassign[t2] vKS
+# 7  <;> nextstate(main 506 (eval 24):1) v:{
+# 8  <0> pushmark sM
+# 9  <$> gv(*a) s
+# a  <1> rv2av[t3] sKRM/1
+# b  <$> gv(*_) s
+# c  <1> rv2gv sKRM/1
+# d  <{> enteriter(next->o last->r redo->e) lKS/8
+# p  <0> iter s
+# q  <|> and(other->e) K/1
+# e      <;> nextstate(main 505 (eval 24):1) v:{
+# f      <$> gvsv(*_) s
+# g      <$> gv(*h) s
+# h      <1> rv2hv sKR/1
+# i      <0> pushmark s
+# j      <$> gvsv(*_) s
+# k      <$> gv(*getkey) s/EARLYCV
+# l      <1> entersub[t4] sKS/TARG,1
+# m      <2> helem sKRM*/2
+# n      <2> sassign vKS/2
+# o      <0> unstack s
+#            goto p
+# r  <2> leaveloop K/2
+# s  <1> leavesub[1 ref] K/REFC,1
+EONT_EONT
+
+checkOptree ( name	=> 'map $_+42, 10..20',
+	      code	=> 'map $_+42, 10..20',
+	      bcopts	=> '-exec',
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 1  <;> nextstate(main 497 (eval 20):1) v
+# 2  <0> pushmark s
+# 3  <$> const[AV ] s
+# 4  <1> rv2av lKPM/1
+# 5  <@> mapstart K
+# 6  <|> mapwhile(other->7)[t5] K
+# 7      <#> gvsv[*_] s
+# 8      <$> const[IV 42] s
+# 9      <2> add[t2] sK/2
+#            goto 6
+# a  <1> leavesub[1 ref] K/REFC,1
+EOT_EOT
+# 1  <;> nextstate(main 511 (eval 26):1) v
+# 2  <0> pushmark s
+# 3  <$> const(AV ) s
+# 4  <1> rv2av lKPM/1
+# 5  <@> mapstart K
+# 6  <|> mapwhile(other->7)[t4] K
+# 7      <$> gvsv(*_) s
+# 8      <$> const(IV 42) s
+# 9      <2> add[t1] sK/2
+#            goto 6
+# a  <1> leavesub[1 ref] K/REFC,1
+EONT_EONT
+
+pass("CONSTANTS");
+
 checkOptree ( name	=> '-e use constant j => qq{junk}; print j',
 	      prog	=> 'use constant j => qq{junk}; print j',
 	      bcopts	=> '-exec',
+	      @open_todo,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # 1  <0> enter 
-# 2  <;> nextstate(main 71 -e:1) v
+# 2  <;> nextstate(main 71 -e:1) v:{
 # 3  <0> pushmark s
 # 4  <$> const[PV "junk"] s
 # 5  <@> print vK
 # 6  <@> leave[1 ref] vKP/REFC
 EOT_EOT
 # 1  <0> enter 
-# 2  <;> nextstate(main 71 -e:1) v
+# 2  <;> nextstate(main 71 -e:1) v:{
 # 3  <0> pushmark s
 # 4  <$> const(PV "junk") s
 # 5  <@> print vK
 # 6  <@> leave[1 ref] vKP/REFC
 EONT_EONT
 
+} # skip
+
 __END__
 
 #######################################################################