[perl5.git] / ext / B / t / optree_concise.t

#!perl

BEGIN {
    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
}

# import checkOptree(), and %gOpts (containing test state)
use OptreeCheck;	# ALSO DOES @ARGV HANDLING !!!!!!
use Config;

my $tests = 23;
plan tests => $tests;
SKIP: {
skip "no perlio in this build", $tests unless $Config::Config{useperlio};

$SIG{__WARN__} = sub {
    my $err = shift;
    $err =~ m/Subroutine re::(un)?install redefined/ and return;
};
#################################
pass("CANONICAL B::Concise EXAMPLE");

checkOptree ( name	=> 'canonical example w -basic',
	      bcopts	=> '-basic',
	      code	=>  sub{$a=$b+42},
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 7  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->7
# 1        <;> nextstate(foo bar) v:{ ->2
# 6        <2> sassign sKS/2 ->7
# 4           <2> add[t3] sK/2 ->5
# -              <1> ex-rv2sv sK/1 ->3
# 2                 <#> gvsv[*b] s ->3
# 3              <$> const[IV 42] s ->4
# -           <1> ex-rv2sv sKRM*/1 ->6
# 5              <#> gvsv[*a] s ->6
EOT_EOT
# 7  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->7
# 1        <;> nextstate(main 60 optree_concise.t:122) v:{ ->2
# 6        <2> sassign sKS/2 ->7
# 4           <2> add[t1] sK/2 ->5
# -              <1> ex-rv2sv sK/1 ->3
# 2                 <$> gvsv(*b) s ->3
# 3              <$> const(IV 42) s ->4
# -           <1> ex-rv2sv sKRM*/1 ->6
# 5              <$> gvsv(*a) s ->6
EONT_EONT

checkOptree ( name	=> 'canonical example w -exec',
	      bcopts	=> '-exec',
	      code	=> sub{$a=$b+42},
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1  <;> nextstate(main 61 optree_concise.t:139) v:{
# 2  <#> gvsv[*b] s
# 3  <$> const[IV 42] s
# 4  <2> add[t3] sK/2
# 5  <#> gvsv[*a] s
# 6  <2> sassign sKS/2
# 7  <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1  <;> nextstate(main 61 optree_concise.t:139) v:{
# 2  <$> gvsv(*b) s
# 3  <$> const(IV 42) s
# 4  <2> add[t1] sK/2
# 5  <$> gvsv(*a) s
# 6  <2> sassign sKS/2
# 7  <1> leavesub[1 ref] K/REFC,1
EONT_EONT

#################################
pass("B::Concise OPTION TESTS");

checkOptree ( name	=> '-base3 sticky-exec',
	      bcopts	=> '-base3',
	      code	=> sub{$a=$b+42},
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1  <;> dbstate(main 24 optree_concise.t:132) v:{
2  <#> gvsv[*b] s
10 <$> const[IV 42] s
11 <2> add[t3] sK/2
12 <#> gvsv[*a] s
20 <2> sassign sKS/2
21 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1  <;> nextstate(main 62 optree_concise.t:161) v:{
# 2  <$> gvsv(*b) s
# 10 <$> const(IV 42) s
# 11 <2> add[t1] sK/2
# 12 <$> gvsv(*a) s
# 20 <2> sassign sKS/2
# 21 <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name	=> 'sticky-base3, -basic over sticky-exec',
	      bcopts	=> '-basic',
	      code	=> sub{$a=$b+42},
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
21 <1> leavesub[1 ref] K/REFC,1 ->(end)
-     <@> lineseq KP ->21
1        <;> nextstate(main 32 optree_concise.t:164) v:{ ->2
20       <2> sassign sKS/2 ->21
11          <2> add[t3] sK/2 ->12
-              <1> ex-rv2sv sK/1 ->10
2                 <#> gvsv[*b] s ->10
10             <$> const[IV 42] s ->11
-           <1> ex-rv2sv sKRM*/1 ->20
12             <#> gvsv[*a] s ->20
EOT_EOT
# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->21
# 1        <;> nextstate(main 63 optree_concise.t:186) v:{ ->2
# 20       <2> sassign sKS/2 ->21
# 11          <2> add[t1] sK/2 ->12
# -              <1> ex-rv2sv sK/1 ->10
# 2                 <$> gvsv(*b) s ->10
# 10             <$> const(IV 42) s ->11
# -           <1> ex-rv2sv sKRM*/1 ->20
# 12             <$> gvsv(*a) s ->20
EONT_EONT

checkOptree ( name	=> '-base4',
	      bcopts	=> [qw/ -basic -base4 /],
	      code	=> sub{$a=$b+42},
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
13 <1> leavesub[1 ref] K/REFC,1 ->(end)
-     <@> lineseq KP ->13
1        <;> nextstate(main 26 optree_concise.t:145) v:{ ->2
12       <2> sassign sKS/2 ->13
10          <2> add[t3] sK/2 ->11
-              <1> ex-rv2sv sK/1 ->3
2                 <#> gvsv[*b] s ->3
3              <$> const[IV 42] s ->10
-           <1> ex-rv2sv sKRM*/1 ->12
11             <#> gvsv[*a] s ->12
EOT_EOT
# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->13
# 1        <;> nextstate(main 64 optree_concise.t:193) v:{ ->2
# 12       <2> sassign sKS/2 ->13
# 10          <2> add[t1] sK/2 ->11
# -              <1> ex-rv2sv sK/1 ->3
# 2                 <$> gvsv(*b) s ->3
# 3              <$> const(IV 42) s ->10
# -           <1> ex-rv2sv sKRM*/1 ->12
# 11             <$> gvsv(*a) s ->12
EONT_EONT

checkOptree ( name	=> "restore -base36 default",
	      bcopts	=> [qw/ -basic -base36 /],
	      code	=> sub{$a},
	      crossfail	=> 1,
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-     <@> lineseq KP ->3
1        <;> nextstate(main 27 optree_concise.t:161) v ->2
-        <1> ex-rv2sv sK/1 ->-
2           <#> gvsv[*a] s ->3
EOT_EOT
# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->3
# 1        <;> nextstate(main 65 optree_concise.t:210) v ->2
# -        <1> ex-rv2sv sK/1 ->-
# 2           <$> gvsv(*a) s ->3
EONT_EONT

checkOptree ( name	=> "terse basic",
	      bcopts	=> [qw/ -basic -terse /],
	      code	=> sub{$a},
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
UNOP (0x82b0918) leavesub [1] 
    LISTOP (0x82b08d8) lineseq 
        COP (0x82b0880) nextstate 
        UNOP (0x82b0860) null [15] 
            PADOP (0x82b0840) gvsv  GV (0x82a818c) *a 
EOT_EOT
# UNOP (0x8282310) leavesub [1] 
#     LISTOP (0x82822f0) lineseq 
#         COP (0x82822b8) nextstate 
#         UNOP (0x812fc20) null [15] 
#             SVOP (0x812fc00) gvsv  GV (0x814692c) *a 
EONT_EONT

checkOptree ( name	=> "sticky-terse exec",
	      bcopts	=> [qw/ -exec /],
	      code	=> sub{$a},
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
COP (0x82b0d70) nextstate 
PADOP (0x82b0d30) gvsv  GV (0x82a818c) *a 
UNOP (0x82b0e08) leavesub [1] 
EOT_EOT
# COP (0x82828e0) nextstate 
# SVOP (0x82828a0) gvsv  GV (0x814692c) *a 
# UNOP (0x8282938) leavesub [1] 
EONT_EONT

pass("OPTIONS IN CMDLINE MODE");

checkOptree ( name => 'cmdline invoke -basic works',
	      prog => 'sort @a',
	      errs => [ 'Useless use of sort in void context at -e line 1.',
			'Name "main::a" used only once: possible typo at -e line 1.',
			],
	      #bcopts	=> '-basic', # default
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 7  <@> leave[1 ref] vKP/REFC ->(end)
# 1     <0> enter ->2
# 2     <;> nextstate(main 1 -e:1) v:{ ->3
# 6     <@> sort vK ->7
# 3        <0> pushmark s ->4
# 5        <1> rv2av[t2] lK/1 ->6
# 4           <#> gv[*a] s ->5
EOT_EOT
# 7  <@> leave[1 ref] vKP/REFC ->(end)
# 1     <0> enter ->2
# 2     <;> nextstate(main 1 -e:1) v:{ ->3
# 6     <@> sort vK ->7
# 3        <0> pushmark s ->4
# 5        <1> rv2av[t1] lK/1 ->6
# 4           <$> gv(*a) s ->5
EONT_EONT

checkOptree ( name => 'cmdline invoke -exec works',
	      prog => 'sort @a',
	      errs => [ 'Useless use of sort in void context at -e line 1.',
			'Name "main::a" used only once: possible typo at -e line 1.',
			],
	      bcopts => '-exec',
	      @open_todo,
	      expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1  <0> enter 
2  <;> nextstate(main 1 -e:1) v:{
3  <0> pushmark s
4  <#> gv[*a] s
5  <1> rv2av[t2] lK/1
6  <@> sort vK
7  <@> leave[1 ref] vKP/REFC
EOT_EOT
# 1  <0> enter 
# 2  <;> nextstate(main 1 -e:1) v:{
# 3  <0> pushmark s
# 4  <$> gv(*a) s
# 5  <1> rv2av[t1] lK/1
# 6  <@> sort vK
# 7  <@> leave[1 ref] vKP/REFC
EONT_EONT

;

checkOptree
    ( name	=> 'cmdline self-strict compile err using prog',
      prog	=> 'use strict; sort @a',
      bcopts	=> [qw/ -basic -concise -exec /],
      errs	=> 'Global symbol "@a" requires explicit package name at -e line 1.',
      expect	=> 'nextstate',
      expect_nt	=> 'nextstate',
      noanchors => 1, # allow simple expectations to work
      );

checkOptree
    ( name	=> 'cmdline self-strict compile err using code',
      code	=> 'use strict; sort @a',
      bcopts	=> [qw/ -basic -concise -exec /],
      errs	=> 'Global symbol "@a" requires explicit package name at .*? line 1.',
      note	=> 'this test relys on a kludge which copies $@ to rendering when empty',
      expect	=> 'Global symbol',
      expect_nt	=> 'Global symbol',
      noanchors => 1, # allow simple expectations to work
      );

checkOptree
    ( name	=> 'cmdline -basic -concise -exec works',
      prog	=> 'our @a; sort @a',
      bcopts	=> [qw/ -basic -concise -exec /],
      errs	=> ['Useless use of sort in void context at -e line 1.'],
      @open_todo,
      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1  <0> enter 
# 2  <;> nextstate(main 1 -e:1) v:{
# 3  <#> gv[*a] s
# 4  <1> rv2av[t3] vK/OURINTR,1
# 5  <;> nextstate(main 2 -e:1) v:{
# 6  <0> pushmark s
# 7  <#> gv[*a] s
# 8  <1> rv2av[t5] lK/1
# 9  <@> sort vK
# a  <@> leave[1 ref] vKP/REFC
EOT_EOT
# 1  <0> enter 
# 2  <;> nextstate(main 1 -e:1) v:{
# 3  <$> gv(*a) s
# 4  <1> rv2av[t2] vK/OURINTR,1
# 5  <;> nextstate(main 2 -e:1) v:{
# 6  <0> pushmark s
# 7  <$> gv(*a) s
# 8  <1> rv2av[t3] lK/1
# 9  <@> sort vK
# a  <@> leave[1 ref] vKP/REFC
EONT_EONT


#################################
pass("B::Concise STYLE/CALLBACK TESTS");

use B::Concise qw( walk_output add_style set_style_standard add_callback );

# new relative style, added by set_up_relative_test()
@stylespec =
    ( "#hyphseq2 (*(   (x( ;)x))*)<#classsym> "
      . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
      . "(x(;~=> #extra)x)\n" # new 'variable' used here
      
      , "  (*(    )*)     goto #seq\n"
      , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
      #. "(x(;~=> #extra)x)\n" # new 'variable' used here
      );

sub set_up_relative_test {
    # add a new style, and a callback which adds an 'extra' property

    add_style ( "relative"	=> @stylespec );
    #set_style_standard ( "relative" );

    add_callback
	( sub {
	    my ($h, $op, $format, $level, $style) = @_;

	    # callback marks up const ops
	    $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
	    $h->{extra} = '';

	    if ($lastnext and $$lastnext != $$op) {
		$h->{goto} = ($h->{seq} eq '-')
		    ? 'unresolved' : $h->{seq};
	    }

	    # 2 style specific behaviors
	    if ($style eq 'relative') {
		$h->{extra} = 'RELATIVE';
		$h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
	    }
	    elsif ($style eq 'scope') {
		# supress printout entirely
		$$format="" unless grep { $h->{name} eq $_ } @scopeops;
	    }
	});
}

#################################
set_up_relative_test();
pass("set_up_relative_test, new callback installed");

checkOptree ( name	=> 'callback used, independent of style',
	      bcopts	=> [qw/ -concise -exec /],
	      code	=> sub{$a=$b+42},
	      @open_todo,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1  <;> nextstate(main 76 optree_concise.t:337) v:{
2  <#> gvsv[*b] s
3  <$> const[IV 42] CALLBACK s
4  <2> add[t3] sK/2
5  <#> gvsv[*a] s
6  <2> sassign sKS/2
7  <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1  <;> nextstate(main 455 optree_concise.t:328) v:{
# 2  <$> gvsv(*b) s
# 3  <$> const(IV 42) CALLBACK s
# 4  <2> add[t1] sK/2
# 5  <$> gvsv(*a) s
# 6  <2> sassign sKS/2
# 7  <1> leavesub[1 ref] K/REFC,1
EONT_EONT

checkOptree ( name	=> "new 'relative' style, -exec mode",
	      bcopts	=> [qw/ -basic -relative /],
	      code	=> sub{$a=$b+42},
	      crossfail	=> 1,
	      #retry	=> 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
7  <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
-     <@> lineseq KP ->7 => RELATIVE
1        <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
6        <2> sassign sKS ->7 => RELATIVE
4           <2> add[t3] sK ->5 => RELATIVE
-              <1> ex-rv2sv sK ->3 => RELATIVE
2                 <#> gvsv[*b] s ->3 => RELATIVE
3              <$> const[IV 42] CALLBACK s ->4 => RELATIVE
-           <1> ex-rv2sv sKRM* ->6 => RELATIVE
5              <#> gvsv[*a] s ->6 => RELATIVE
EOT_EOT
# 7  <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
# -     <@> lineseq KP ->7 => RELATIVE
# 1        <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
# 6        <2> sassign sKS ->7 => RELATIVE
# 4           <2> add[t1] sK ->5 => RELATIVE
# -              <1> ex-rv2sv sK ->3 => RELATIVE
# 2                 <$> gvsv(*b) s ->3 => RELATIVE
# 3              <$> const(IV 42) CALLBACK s ->4 => RELATIVE
# -           <1> ex-rv2sv sKRM* ->6 => RELATIVE
# 5              <$> gvsv(*a) s ->6 => RELATIVE
EONT_EONT

checkOptree ( name	=> "both -exec -relative",
	      bcopts	=> [qw/ -exec -relative /],
	      code	=> sub{$a=$b+42},
	      crossfail	=> 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1  <;> nextstate(main 50 optree_concise.t:326) v 
2  <#> gvsv[*b] s 
3  <$> const[IV 42] CALLBACK s 
4  <2> add[t3] sK 
5  <#> gvsv[*a] s 
6  <2> sassign sKS 
7  <1> leavesub RELATIVE[1 ref] K 
EOT_EOT
# 1  <;> nextstate(main 78 optree_concise.t:371) v 
# 2  <$> gvsv(*b) s 
# 3  <$> const(IV 42) CALLBACK s 
# 4  <2> add[t1] sK 
# 5  <$> gvsv(*a) s 
# 6  <2> sassign sKS 
# 7  <1> leavesub RELATIVE[1 ref] K 
EONT_EONT

#################################

@scopeops = qw( leavesub enter leave nextstate );
add_style
	( 'scope'  # concise copy
	  , "#hyphseq2 (*(   (x( ;)x))*)<#classsym> "
	  . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
	  , "  (*(    )*)     goto #seq\n"
	  , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
	 );

checkOptree ( name	=> "both -exec -scope",
	      bcopts	=> [qw/ -exec -scope /],
	      code	=> sub{$a=$b+42},
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1  <;> nextstate(main 50 optree_concise.t:337) v 
7  <1> leavesub[1 ref] K/REFC,1 
EOT_EOT
1  <;> nextstate(main 75 optree_concise.t:396) v 
7  <1> leavesub[1 ref] K/REFC,1 
EONT_EONT


checkOptree ( name	=> "both -basic -scope",
	      bcopts	=> [qw/ -basic -scope /],
	      code	=> sub{$a=$b+42},
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
7  <1> leavesub[1 ref] K/REFC,1 ->(end) 
1        <;> nextstate(main 51 optree_concise.t:347) v ->2 
EOT_EOT
7  <1> leavesub[1 ref] K/REFC,1 ->(end) 
1        <;> nextstate(main 76 optree_concise.t:407) v ->2 
EONT_EONT

} #skip
Commit	Line	Data
724aa791 JC	1	#!perl
	2
	3	BEGIN {
5638aaac SM	4	if ($ENV{PERL_CORE}){
	5	chdir('t') if -d 't';
	6	@INC = ('.', '../lib', '../ext/B/t');
	7	} else {
	8	unshift @INC, 't';
	9	push @INC, "../../t";
	10	}
9cd8f857 NC	11	require Config;
	12	if (($Config::Config{'extensions'} !~ /\bB\b/) ){
	13	print "1..0 # Skip -- Perl configured without B module\n";
	14	exit 0;
	15	}
19e169bf	16	# require 'test.pl'; # now done by OptreeCheck
724aa791 JC	17	}
	18
	19	# import checkOptree(), and %gOpts (containing test state)
	20	use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
2ce64696	21	use Config;
724aa791	22
b37cb821 NC	23	my $tests = 23;
b37cb821 NC	24	plan tests => $tests;
2ce64696	25	SKIP: {
b37cb821	26	skip "no perlio in this build", $tests unless $Config::Config{useperlio};
724aa791 JC	27
	28	$SIG{__WARN__} = sub {
	29	my $err = shift;
	30	$err =~ m/Subroutine re::(un)?install redefined/ and return;
	31	};
	32	#################################
	33	pass("CANONICAL B::Concise EXAMPLE");
	34
	35	checkOptree ( name => 'canonical example w -basic',
	36	bcopts => '-basic',
	37	code => sub{$a=$b+42},
09337566	38	@open_todo,
724aa791	39	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
19e169bf	40	# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
724aa791	41	# - <@> lineseq KP ->7
d5ec2987	42	# 1 <;> nextstate(foo bar) v:{ ->2
724aa791	43	# 6 <2> sassign sKS/2 ->7
19e169bf	44	# 4 <2> add[t3] sK/2 ->5
724aa791 JC	45	# - <1> ex-rv2sv sK/1 ->3
	46	# 2 <#> gvsv[*b] s ->3
	47	# 3 <$> const[IV 42] s ->4
	48	# - <1> ex-rv2sv sKRM*/1 ->6
	49	# 5 <#> gvsv[*a] s ->6
	50	EOT_EOT
	51	# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
	52	# - <@> lineseq KP ->7
d5ec2987	53	# 1 <;> nextstate(main 60 optree_concise.t:122) v:{ ->2
724aa791 JC	54	# 6 <2> sassign sKS/2 ->7
	55	# 4 <2> add[t1] sK/2 ->5
	56	# - <1> ex-rv2sv sK/1 ->3
	57	# 2 <$> gvsv(*b) s ->3
	58	# 3 <$> const(IV 42) s ->4
	59	# - <1> ex-rv2sv sKRM*/1 ->6
	60	# 5 <$> gvsv(*a) s ->6
	61	EONT_EONT
	62
	63	checkOptree ( name => 'canonical example w -exec',
	64	bcopts => '-exec',
	65	code => sub{$a=$b+42},
09337566	66	@open_todo,
724aa791	67	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987	68	# 1 <;> nextstate(main 61 optree_concise.t:139) v:{
724aa791 JC	69	# 2 <#> gvsv[*b] s
	70	# 3 <$> const[IV 42] s
	71	# 4 <2> add[t3] sK/2
	72	# 5 <#> gvsv[*a] s
	73	# 6 <2> sassign sKS/2
	74	# 7 <1> leavesub[1 ref] K/REFC,1
	75	EOT_EOT
d5ec2987	76	# 1 <;> nextstate(main 61 optree_concise.t:139) v:{
724aa791 JC	77	# 2 <$> gvsv(*b) s
	78	# 3 <$> const(IV 42) s
	79	# 4 <2> add[t1] sK/2
	80	# 5 <$> gvsv(*a) s
	81	# 6 <2> sassign sKS/2
	82	# 7 <1> leavesub[1 ref] K/REFC,1
	83	EONT_EONT
	84
724aa791 JC	85	#################################
	86	pass("B::Concise OPTION TESTS");
	87
	88	checkOptree ( name => '-base3 sticky-exec',
	89	bcopts => '-base3',
	90	code => sub{$a=$b+42},
09337566	91	@open_todo,
724aa791	92	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987	93	1 <;> dbstate(main 24 optree_concise.t:132) v:{
724aa791 JC	94	2 <#> gvsv[*b] s
	95	10 <$> const[IV 42] s
	96	11 <2> add[t3] sK/2
	97	12 <#> gvsv[*a] s
	98	20 <2> sassign sKS/2
cc02ea56	99	21 <1> leavesub[1 ref] K/REFC,1
724aa791	100	EOT_EOT
d5ec2987	101	# 1 <;> nextstate(main 62 optree_concise.t:161) v:{
724aa791 JC	102	# 2 <$> gvsv(*b) s
	103	# 10 <$> const(IV 42) s
	104	# 11 <2> add[t1] sK/2
	105	# 12 <$> gvsv(*a) s
	106	# 20 <2> sassign sKS/2
	107	# 21 <1> leavesub[1 ref] K/REFC,1
	108	EONT_EONT
	109
	110	checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
	111	bcopts => '-basic',
	112	code => sub{$a=$b+42},
09337566	113	@open_todo,
724aa791 JC	114	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	115	21 <1> leavesub[1 ref] K/REFC,1 ->(end)
	116	- <@> lineseq KP ->21
d5ec2987	117	1 <;> nextstate(main 32 optree_concise.t:164) v:{ ->2
724aa791 JC	118	20 <2> sassign sKS/2 ->21
	119	11 <2> add[t3] sK/2 ->12
	120	- <1> ex-rv2sv sK/1 ->10
	121	2 <#> gvsv[*b] s ->10
	122	10 <$> const[IV 42] s ->11
	123	- <1> ex-rv2sv sKRM*/1 ->20
	124	12 <#> gvsv[*a] s ->20
	125	EOT_EOT
	126	# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
	127	# - <@> lineseq KP ->21
d5ec2987	128	# 1 <;> nextstate(main 63 optree_concise.t:186) v:{ ->2
724aa791 JC	129	# 20 <2> sassign sKS/2 ->21
	130	# 11 <2> add[t1] sK/2 ->12
	131	# - <1> ex-rv2sv sK/1 ->10
	132	# 2 <$> gvsv(*b) s ->10
	133	# 10 <$> const(IV 42) s ->11
	134	# - <1> ex-rv2sv sKRM*/1 ->20
	135	# 12 <$> gvsv(*a) s ->20
	136	EONT_EONT
	137
	138	checkOptree ( name => '-base4',
	139	bcopts => [qw/ -basic -base4 /],
	140	code => sub{$a=$b+42},
09337566	141	@open_todo,
724aa791 JC	142	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	143	13 <1> leavesub[1 ref] K/REFC,1 ->(end)
	144	- <@> lineseq KP ->13
d5ec2987	145	1 <;> nextstate(main 26 optree_concise.t:145) v:{ ->2
724aa791 JC	146	12 <2> sassign sKS/2 ->13
	147	10 <2> add[t3] sK/2 ->11
	148	- <1> ex-rv2sv sK/1 ->3
	149	2 <#> gvsv[*b] s ->3
	150	3 <$> const[IV 42] s ->10
	151	- <1> ex-rv2sv sKRM*/1 ->12
	152	11 <#> gvsv[*a] s ->12
	153	EOT_EOT
	154	# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
	155	# - <@> lineseq KP ->13
d5ec2987	156	# 1 <;> nextstate(main 64 optree_concise.t:193) v:{ ->2
724aa791 JC	157	# 12 <2> sassign sKS/2 ->13
	158	# 10 <2> add[t1] sK/2 ->11
	159	# - <1> ex-rv2sv sK/1 ->3
	160	# 2 <$> gvsv(*b) s ->3
	161	# 3 <$> const(IV 42) s ->10
	162	# - <1> ex-rv2sv sKRM*/1 ->12
	163	# 11 <$> gvsv(*a) s ->12
	164	EONT_EONT
	165
	166	checkOptree ( name => "restore -base36 default",
	167	bcopts => [qw/ -basic -base36 /],
	168	code => sub{$a},
	169	crossfail => 1,
09337566	170	@open_todo,
724aa791 JC	171	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	172	3 <1> leavesub[1 ref] K/REFC,1 ->(end)
	173	- <@> lineseq KP ->3
	174	1 <;> nextstate(main 27 optree_concise.t:161) v ->2
	175	- <1> ex-rv2sv sK/1 ->-
	176	2 <#> gvsv[*a] s ->3
	177	EOT_EOT
	178	# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
	179	# - <@> lineseq KP ->3
	180	# 1 <;> nextstate(main 65 optree_concise.t:210) v ->2
	181	# - <1> ex-rv2sv sK/1 ->-
	182	# 2 <$> gvsv(*a) s ->3
	183	EONT_EONT
	184
	185	checkOptree ( name => "terse basic",
	186	bcopts => [qw/ -basic -terse /],
	187	code => sub{$a},
	188	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	189	UNOP (0x82b0918) leavesub [1]
	190	LISTOP (0x82b08d8) lineseq
	191	COP (0x82b0880) nextstate
	192	UNOP (0x82b0860) null [15]
	193	PADOP (0x82b0840) gvsv GV (0x82a818c) *a
	194	EOT_EOT
	195	# UNOP (0x8282310) leavesub [1]
	196	# LISTOP (0x82822f0) lineseq
	197	# COP (0x82822b8) nextstate
	198	# UNOP (0x812fc20) null [15]
	199	# SVOP (0x812fc00) gvsv GV (0x814692c) *a
	200	EONT_EONT
	201
	202	checkOptree ( name => "sticky-terse exec",
	203	bcopts => [qw/ -exec /],
	204	code => sub{$a},
	205	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 JC	206	COP (0x82b0d70) nextstate
	207	PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
	208	UNOP (0x82b0e08) leavesub [1]
	209	EOT_EOT
724aa791 JC	210	# COP (0x82828e0) nextstate
	211	# SVOP (0x82828a0) gvsv GV (0x814692c) *a
	212	# UNOP (0x8282938) leavesub [1]
	213	EONT_EONT
	214
	215	pass("OPTIONS IN CMDLINE MODE");
	216
19e169bf JC	217	checkOptree ( name => 'cmdline invoke -basic works',
	218	prog => 'sort @a',
	219	errs => [ 'Useless use of sort in void context at -e line 1.',
	220	'Name "main::a" used only once: possible typo at -e line 1.',
	221	],
724aa791	222	#bcopts => '-basic', # default
09337566	223	@open_todo,
724aa791 JC	224	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	225	# 7 <@> leave[1 ref] vKP/REFC ->(end)
	226	# 1 <0> enter ->2
d5ec2987	227	# 2 <;> nextstate(main 1 -e:1) v:{ ->3
724aa791 JC	228	# 6 <@> sort vK ->7
	229	# 3 <0> pushmark s ->4
	230	# 5 <1> rv2av[t2] lK/1 ->6
	231	# 4 <#> gv[*a] s ->5
	232	EOT_EOT
	233	# 7 <@> leave[1 ref] vKP/REFC ->(end)
	234	# 1 <0> enter ->2
d5ec2987	235	# 2 <;> nextstate(main 1 -e:1) v:{ ->3
724aa791 JC	236	# 6 <@> sort vK ->7
	237	# 3 <0> pushmark s ->4
	238	# 5 <1> rv2av[t1] lK/1 ->6
	239	# 4 <$> gv(*a) s ->5
	240	EONT_EONT
	241
19e169bf JC	242	checkOptree ( name => 'cmdline invoke -exec works',
	243	prog => 'sort @a',
	244	errs => [ 'Useless use of sort in void context at -e line 1.',
	245	'Name "main::a" used only once: possible typo at -e line 1.',
	246	],
	247	bcopts => '-exec',
09337566	248	@open_todo,
19e169bf	249	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791	250	1 <0> enter
d5ec2987	251	2 <;> nextstate(main 1 -e:1) v:{
724aa791 JC	252	3 <0> pushmark s
	253	4 <#> gv[*a] s
	254	5 <1> rv2av[t2] lK/1
	255	6 <@> sort vK
	256	7 <@> leave[1 ref] vKP/REFC
	257	EOT_EOT
	258	# 1 <0> enter
d5ec2987	259	# 2 <;> nextstate(main 1 -e:1) v:{
724aa791 JC	260	# 3 <0> pushmark s
	261	# 4 <$> gv(*a) s
	262	# 5 <1> rv2av[t1] lK/1
	263	# 6 <@> sort vK
	264	# 7 <@> leave[1 ref] vKP/REFC
	265	EONT_EONT
	266
5e251bf1	267	;
19e169bf	268
5e251bf1 JC	269	checkOptree
	270	( name => 'cmdline self-strict compile err using prog',
	271	prog => 'use strict; sort @a',
	272	bcopts => [qw/ -basic -concise -exec /],
19e169bf JC	273	errs => 'Global symbol "@a" requires explicit package name at -e line 1.',
	274	expect => 'nextstate',
	275	expect_nt => 'nextstate',
	276	noanchors => 1, # allow simple expectations to work
5e251bf1	277	);
724aa791	278
5e251bf1 JC	279	checkOptree
	280	( name => 'cmdline self-strict compile err using code',
	281	code => 'use strict; sort @a',
	282	bcopts => [qw/ -basic -concise -exec /],
5e251bf1	283	errs => 'Global symbol "@a" requires explicit package name at .*? line 1.',
19e169bf JC	284	note => 'this test relys on a kludge which copies $@ to rendering when empty',
	285	expect => 'Global symbol',
	286	expect_nt => 'Global symbol',
	287	noanchors => 1, # allow simple expectations to work
5e251bf1 JC	288	);
	289
	290	checkOptree
	291	( name => 'cmdline -basic -concise -exec works',
	292	prog => 'our @a; sort @a',
	293	bcopts => [qw/ -basic -concise -exec /],
19e169bf	294	errs => ['Useless use of sort in void context at -e line 1.'],
09337566	295	@open_todo,
5e251bf1	296	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791	297	# 1 <0> enter
d5ec2987	298	# 2 <;> nextstate(main 1 -e:1) v:{
724aa791 JC	299	# 3 <#> gv[*a] s
724aa791 JC	300	# 4 <1> rv2av[t3] vK/OURINTR,1
d5ec2987	301	# 5 <;> nextstate(main 2 -e:1) v:{
724aa791 JC	302	# 6 <0> pushmark s
	303	# 7 <#> gv[*a] s
	304	# 8 <1> rv2av[t5] lK/1
	305	# 9 <@> sort vK
	306	# a <@> leave[1 ref] vKP/REFC
	307	EOT_EOT
	308	# 1 <0> enter
d5ec2987	309	# 2 <;> nextstate(main 1 -e:1) v:{
724aa791 JC	310	# 3 <$> gv(*a) s
724aa791 JC	311	# 4 <1> rv2av[t2] vK/OURINTR,1
d5ec2987	312	# 5 <;> nextstate(main 2 -e:1) v:{
724aa791 JC	313	# 6 <0> pushmark s
	314	# 7 <$> gv(*a) s
	315	# 8 <1> rv2av[t3] lK/1
	316	# 9 <@> sort vK
	317	# a <@> leave[1 ref] vKP/REFC
	318	EONT_EONT
	319
	320
	321	#################################
	322	pass("B::Concise STYLE/CALLBACK TESTS");
	323
	324	use B::Concise qw( walk_output add_style set_style_standard add_callback );
	325
	326	# new relative style, added by set_up_relative_test()
	327	@stylespec =
	328	( "#hyphseq2 (( (x( ;)x)))<#classsym> "
	329	. "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
	330	. "(x(;~=> #extra)x)\n" # new 'variable' used here
	331
	332	, " (( )) goto #seq\n"
cc02ea56	333	, "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
724aa791 JC	334	#. "(x(;~=> #extra)x)\n" # new 'variable' used here
	335	);
	336
	337	sub set_up_relative_test {
	338	# add a new style, and a callback which adds an 'extra' property
	339
	340	add_style ( "relative" => @stylespec );
	341	#set_style_standard ( "relative" );
	342
	343	add_callback
	344	( sub {
	345	my ($h, $op, $format, $level, $style) = @_;
	346
	347	# callback marks up const ops
	348	$h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
	349	$h->{extra} = '';
	350
cc02ea56 JC	351	if ($lastnext and $$lastnext != $$op) {
	352	$h->{goto} = ($h->{seq} eq '-')
	353	? 'unresolved' : $h->{seq};
	354	}
	355
724aa791 JC	356	# 2 style specific behaviors
	357	if ($style eq 'relative') {
	358	$h->{extra} = 'RELATIVE';
	359	$h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
	360	}
	361	elsif ($style eq 'scope') {
	362	# supress printout entirely
	363	$$format="" unless grep { $h->{name} eq $_ } @scopeops;
	364	}
	365	});
	366	}
	367
	368	#################################
	369	set_up_relative_test();
	370	pass("set_up_relative_test, new callback installed");
	371
	372	checkOptree ( name => 'callback used, independent of style',
	373	bcopts => [qw/ -concise -exec /],
	374	code => sub{$a=$b+42},
09337566	375	@open_todo,
724aa791	376	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987	377	1 <;> nextstate(main 76 optree_concise.t:337) v:{
724aa791 JC	378	2 <#> gvsv[*b] s
	379	3 <$> const[IV 42] CALLBACK s
	380	4 <2> add[t3] sK/2
	381	5 <#> gvsv[*a] s
	382	6 <2> sassign sKS/2
	383	7 <1> leavesub[1 ref] K/REFC,1
	384	EOT_EOT
d5ec2987	385	# 1 <;> nextstate(main 455 optree_concise.t:328) v:{
724aa791 JC	386	# 2 <$> gvsv(*b) s
	387	# 3 <$> const(IV 42) CALLBACK s
	388	# 4 <2> add[t1] sK/2
	389	# 5 <$> gvsv(*a) s
	390	# 6 <2> sassign sKS/2
	391	# 7 <1> leavesub[1 ref] K/REFC,1
	392	EONT_EONT
	393
	394	checkOptree ( name => "new 'relative' style, -exec mode",
	395	bcopts => [qw/ -basic -relative /],
	396	code => sub{$a=$b+42},
	397	crossfail => 1,
	398	#retry => 1,
	399	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
cc02ea56 JC	400	7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
	401	- <@> lineseq KP ->7 => RELATIVE
	402	1 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
	403	6 <2> sassign sKS ->7 => RELATIVE
	404	4 <2> add[t3] sK ->5 => RELATIVE
	405	- <1> ex-rv2sv sK ->3 => RELATIVE
	406	2 <#> gvsv[*b] s ->3 => RELATIVE
	407	3 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
	408	- <1> ex-rv2sv sKRM* ->6 => RELATIVE
	409	5 <#> gvsv[*a] s ->6 => RELATIVE
724aa791	410	EOT_EOT
cc02ea56 JC	411	# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
	412	# - <@> lineseq KP ->7 => RELATIVE
	413	# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
	414	# 6 <2> sassign sKS ->7 => RELATIVE
	415	# 4 <2> add[t1] sK ->5 => RELATIVE
	416	# - <1> ex-rv2sv sK ->3 => RELATIVE
	417	# 2 <$> gvsv(*b) s ->3 => RELATIVE
	418	# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
	419	# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
	420	# 5 <$> gvsv(*a) s ->6 => RELATIVE
724aa791 JC	421	EONT_EONT
	422
	423	checkOptree ( name => "both -exec -relative",
	424	bcopts => [qw/ -exec -relative /],
	425	code => sub{$a=$b+42},
	426	crossfail => 1,
	427	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 JC	428	1 <;> nextstate(main 50 optree_concise.t:326) v
	429	2 <#> gvsv[*b] s
	430	3 <$> const[IV 42] CALLBACK s
	431	4 <2> add[t3] sK
	432	5 <#> gvsv[*a] s
	433	6 <2> sassign sKS
	434	7 <1> leavesub RELATIVE[1 ref] K
	435	EOT_EOT
	436	# 1 <;> nextstate(main 78 optree_concise.t:371) v
	437	# 2 <$> gvsv(*b) s
	438	# 3 <$> const(IV 42) CALLBACK s
	439	# 4 <2> add[t1] sK
	440	# 5 <$> gvsv(*a) s
	441	# 6 <2> sassign sKS
	442	# 7 <1> leavesub RELATIVE[1 ref] K
	443	EONT_EONT
	444
	445	#################################
	446
	447	@scopeops = qw( leavesub enter leave nextstate );
	448	add_style
	449	( 'scope' # concise copy
	450	, "#hyphseq2 (( (x( ;)x)))<#classsym> "
	451	. "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
	452	, " (( )) goto #seq\n"
	453	, "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
	454	);
	455
	456	checkOptree ( name => "both -exec -scope",
	457	bcopts => [qw/ -exec -scope /],
	458	code => sub{$a=$b+42},
	459	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 JC	460	1 <;> nextstate(main 50 optree_concise.t:337) v
	461	7 <1> leavesub[1 ref] K/REFC,1
	462	EOT_EOT
724aa791 JC	463	1 <;> nextstate(main 75 optree_concise.t:396) v
	464	7 <1> leavesub[1 ref] K/REFC,1
	465	EONT_EONT
	466
	467
	468	checkOptree ( name => "both -basic -scope",
	469	bcopts => [qw/ -basic -scope /],
	470	code => sub{$a=$b+42},
	471	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	472	7 <1> leavesub[1 ref] K/REFC,1 ->(end)
	473	1 <;> nextstate(main 51 optree_concise.t:347) v ->2
	474	EOT_EOT
	475	7 <1> leavesub[1 ref] K/REFC,1 ->(end)
	476	1 <;> nextstate(main 76 optree_concise.t:407) v ->2
	477	EONT_EONT
	478
2ce64696	479	} #skip
724aa791	480