diff options
author | Nicholas Clark <nick@ccl4.org> | 2021-09-16 10:40:27 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2021-09-16 13:22:06 +0000 |
commit | 7961cfc17f76e7d41ff840ad69746d54922bffe9 (patch) | |
tree | 744b5dd2d5d6ecf4244dda91c6b8e671d5b24f0d /ext | |
parent | 66e1ef42e57482043a617e825835d1ded9ac5d3e (diff) | |
download | perl-7961cfc17f76e7d41ff840ad69746d54922bffe9.tar.gz |
Remove former SKIP blocks in ext/B/t/concise.t and re-indent
Diffstat (limited to 'ext')
-rw-r--r-- | ext/B/t/concise.t | 404 |
1 files changed, 200 insertions, 204 deletions
diff --git a/ext/B/t/concise.t b/ext/B/t/concise.t index 41ac70aaab..58d0103404 100644 --- a/ext/B/t/concise.t +++ b/ext/B/t/concise.t @@ -69,20 +69,18 @@ eval { walk_output($foo) }; is ($@, '', "walk_output() accepts obj that can print"); # test that walk_output accepts a HANDLE arg -{ - foreach my $foo (\*STDOUT, \*STDERR) { - eval { walk_output($foo) }; - is ($@, '', "walk_output() accepts STD* " . ref $foo); - } +foreach my $foo (\*STDOUT, \*STDERR) { + eval { walk_output($foo) }; + is ($@, '', "walk_output() accepts STD* " . ref $foo); +} - # now test a ref to scalar - eval { walk_output(\my $junk) }; - is ($@, '', "walk_output() accepts ref-to-sprintf target"); +# now test a ref to scalar +eval { walk_output(\my $junk) }; +is ($@, '', "walk_output() accepts ref-to-sprintf target"); - $junk = "non-empty"; - eval { walk_output(\$junk) }; - is ($@, '', "walk_output() accepts ref-to-non-empty-scalar"); -} +$junk = "non-empty"; +eval { walk_output(\$junk) }; +is ($@, '', "walk_output() accepts ref-to-non-empty-scalar"); ## add_style my @stylespec; @@ -125,226 +123,224 @@ sub render { return $out; } -{ - # tests output to GLOB, using perlio feature directly - set_style_standard('concise'); # MUST CALL before output needed - - @options = qw( - -basic -exec -tree -compact -loose -vt -ascii - -base10 -bigendian -littleendian - ); - foreach $opt (@options) { - ($out) = render($opt, $func); - isnt($out, '', "got output with option $opt"); - } - - ## test output control via walk_output - - my $treegen = B::Concise::compile('-basic', $func); # reused - - { # test output into a package global string (sprintf-ish) - our $thing; - walk_output(\$thing); - $treegen->(); - ok($thing, "walk_output to our SCALAR, output seen"); - } - - # test walkoutput acceptance of a scalar-bound IO handle - open (my $fh, '>', \my $buf); - walk_output($fh); +# tests output to GLOB, using perlio feature directly +set_style_standard('concise'); # MUST CALL before output needed + +@options = qw( + -basic -exec -tree -compact -loose -vt -ascii + -base10 -bigendian -littleendian + ); +foreach $opt (@options) { + ($out) = render($opt, $func); + isnt($out, '', "got output with option $opt"); +} + +## test output control via walk_output + +my $treegen = B::Concise::compile('-basic', $func); # reused + +{ # test output into a package global string (sprintf-ish) + our $thing; + walk_output(\$thing); $treegen->(); - ok($buf, "walk_output to GLOB, output seen"); - - ## test B::Concise::compile error checking - - # call compile on non-CODE ref items - if (0) { - # pending STASH splaying - - foreach my $ref ([], {}) { - my $typ = ref $ref; - walk_output(\my $out); - eval { B::Concise::compile('-basic', $ref)->() }; - like ($@, qr/^err: not a coderef: $typ/, - "compile detects $typ-ref where expecting subref"); - is($out,'', "no output when errd"); # announcement prints - } + ok($thing, "walk_output to our SCALAR, output seen"); +} + +# test walkoutput acceptance of a scalar-bound IO handle +open (my $fh, '>', \my $buf); +walk_output($fh); +$treegen->(); +ok($buf, "walk_output to GLOB, output seen"); + +## test B::Concise::compile error checking + +# call compile on non-CODE ref items +if (0) { + # pending STASH splaying + + foreach my $ref ([], {}) { + my $typ = ref $ref; + walk_output(\my $out); + eval { B::Concise::compile('-basic', $ref)->() }; + like ($@, qr/^err: not a coderef: $typ/, + "compile detects $typ-ref where expecting subref"); + is($out,'', "no output when errd"); # announcement prints } - - # test against a bogus autovivified subref. - # in debugger, it should look like: - # 1 CODE(0x84840cc) - # -> &CODE(0x84840cc) in ??? - - my ($res,$err); - TODO: { - #local $TODO = "\tdoes this handling make sense ?"; - - sub declared_only; - ($res,$err) = render('-basic', \&declared_only); - like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/, - "'sub decl_only' seen as having no START"); - - sub defd_empty {}; - ($res,$err) = render('-basic', \&defd_empty); - my @lines = split(/\n/, $res); - is(scalar @lines, 3, - "'sub defd_empty {}' seen as 3 liner"); - - is(1, $res =~ /leavesub/ && $res =~ /(next|db)state/, - "'sub defd_empty {}' seen as 2 ops: leavesub,nextstate"); - - ($res,$err) = render('-basic', \¬_even_declared); - like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/, - "'\¬_even_declared' seen as having no START"); - - { - package Bar; - our $AUTOLOAD = 'garbage'; - sub AUTOLOAD { print "# in AUTOLOAD body: $AUTOLOAD\n" } - } - ($res,$err) = render('-basic', Bar::auto_func); - like ($res, qr/unknown function \(Bar::auto_func\)/, - "Bar::auto_func seen as unknown function"); - - ($res,$err) = render('-basic', \&Bar::auto_func); - like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/, - "'\&Bar::auto_func' seen as having no START"); - - ($res,$err) = render('-basic', \&Bar::AUTOLOAD); - like ($res, qr/in AUTOLOAD body: /, "found body of Bar::AUTOLOAD"); +} +# test against a bogus autovivified subref. +# in debugger, it should look like: +# 1 CODE(0x84840cc) +# -> &CODE(0x84840cc) in ??? + +my ($res,$err); +TODO: { + #local $TODO = "\tdoes this handling make sense ?"; + + sub declared_only; + ($res,$err) = render('-basic', \&declared_only); + like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/, + "'sub decl_only' seen as having no START"); + + sub defd_empty {}; + ($res,$err) = render('-basic', \&defd_empty); + my @lines = split(/\n/, $res); + is(scalar @lines, 3, + "'sub defd_empty {}' seen as 3 liner"); + + is(1, $res =~ /leavesub/ && $res =~ /(next|db)state/, + "'sub defd_empty {}' seen as 2 ops: leavesub,nextstate"); + + ($res,$err) = render('-basic', \¬_even_declared); + like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/, + "'\¬_even_declared' seen as having no START"); + + { + package Bar; + our $AUTOLOAD = 'garbage'; + sub AUTOLOAD { print "# in AUTOLOAD body: $AUTOLOAD\n" } } - ($res,$err) = render('-basic', Foo::bar); - like ($res, qr/unknown function \(Foo::bar\)/, - "BC::compile detects fn-name as unknown function"); + ($res,$err) = render('-basic', Bar::auto_func); + like ($res, qr/unknown function \(Bar::auto_func\)/, + "Bar::auto_func seen as unknown function"); - # v.62 tests + ($res,$err) = render('-basic', \&Bar::auto_func); + like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/, + "'\&Bar::auto_func' seen as having no START"); - pass ("TEST POST-COMPILE OPTION-HANDLING IN WALKER SUBROUTINE"); - - my $sample; + ($res,$err) = render('-basic', \&Bar::AUTOLOAD); + like ($res, qr/in AUTOLOAD body: /, "found body of Bar::AUTOLOAD"); - my $walker = B::Concise::compile('-basic', $func); - walk_output(\$sample); - $walker->('-exec'); - like($sample, qr/goto/m, "post-compile -exec"); +} +($res,$err) = render('-basic', Foo::bar); +like ($res, qr/unknown function \(Foo::bar\)/, + "BC::compile detects fn-name as unknown function"); - walk_output(\$sample); - $walker->('-basic'); - unlike($sample, qr/goto/m, "post-compile -basic"); +# v.62 tests +pass ("TEST POST-COMPILE OPTION-HANDLING IN WALKER SUBROUTINE"); - # bang at it combinatorically - my %combos; - my @modes = qw( -basic -exec ); - my @styles = qw( -concise -debug -linenoise -terse ); +my $sample; - # prep samples - for $style (@styles) { - for $mode (@modes) { - walk_output(\$sample); - reset_sequence(); - $walker->($style, $mode); - $combos{"$style$mode"} = $sample; - } - } - # crosscheck that samples are all text-different - @list = sort keys %combos; - for $i (0..$#list) { - for $j ($i+1..$#list) { - isnt ($combos{$list[$i]}, $combos{$list[$j]}, - "combos for $list[$i] and $list[$j] are different, as expected"); - } - } - - # add samples with styles in different order +my $walker = B::Concise::compile('-basic', $func); +walk_output(\$sample); +$walker->('-exec'); +like($sample, qr/goto/m, "post-compile -exec"); + +walk_output(\$sample); +$walker->('-basic'); +unlike($sample, qr/goto/m, "post-compile -basic"); + + +# bang at it combinatorically +my %combos; +my @modes = qw( -basic -exec ); +my @styles = qw( -concise -debug -linenoise -terse ); + +# prep samples +for $style (@styles) { for $mode (@modes) { - for $style (@styles) { - reset_sequence(); - walk_output(\$sample); - $walker->($mode, $style); - $combos{"$mode$style"} = $sample; - } + walk_output(\$sample); + reset_sequence(); + $walker->($style, $mode); + $combos{"$style$mode"} = $sample; } - # test commutativity of flags, ie that AB == BA - for $mode (@modes) { - for $style (@styles) { - is ( $combos{"$style$mode"}, - $combos{"$mode$style"}, - "results for $style$mode vs $mode$style are the same" ); - } +} +# crosscheck that samples are all text-different +@list = sort keys %combos; +for $i (0..$#list) { + for $j ($i+1..$#list) { + isnt ($combos{$list[$i]}, $combos{$list[$j]}, + "combos for $list[$i] and $list[$j] are different, as expected"); } +} - my %save = %combos; - %combos = (); # outputs for $mode=any($order) and any($style) - - # add more samples with switching modes & sticky styles +# add samples with styles in different order +for $mode (@modes) { for $style (@styles) { - walk_output(\$sample); - reset_sequence(); - $walker->($style); - for $mode (@modes) { - walk_output(\$sample); - reset_sequence(); - $walker->($mode); - $combos{"$style/$mode"} = $sample; - } + reset_sequence(); + walk_output(\$sample); + $walker->($mode, $style); + $combos{"$mode$style"} = $sample; } - # crosscheck that samples are all text-different - @nm = sort keys %combos; - for $i (0..$#nm) { - for $j ($i+1..$#nm) { - isnt ($combos{$nm[$i]}, $combos{$nm[$j]}, - "results for $nm[$i] and $nm[$j] are different, as expected"); - } +} +# test commutativity of flags, ie that AB == BA +for $mode (@modes) { + for $style (@styles) { + is ( $combos{"$style$mode"}, + $combos{"$mode$style"}, + "results for $style$mode vs $mode$style are the same" ); } - - # add samples with switching styles & sticky modes +} + +my %save = %combos; +%combos = (); # outputs for $mode=any($order) and any($style) + +# add more samples with switching modes & sticky styles +for $style (@styles) { + walk_output(\$sample); + reset_sequence(); + $walker->($style); for $mode (@modes) { - walk_output(\$sample); - reset_sequence(); - $walker->($mode); - for $style (@styles) { - walk_output(\$sample); - reset_sequence(); - $walker->($style); - $combos{"$mode/$style"} = $sample; - } + walk_output(\$sample); + reset_sequence(); + $walker->($mode); + $combos{"$style/$mode"} = $sample; } - # test commutativity of flags, ie that AB == BA - for $mode (@modes) { - for $style (@styles) { - is ( $combos{"$style/$mode"}, - $combos{"$mode/$style"}, - "results for $style/$mode vs $mode/$style are the same" ); - } +} +# crosscheck that samples are all text-different +@nm = sort keys %combos; +for $i (0..$#nm) { + for $j ($i+1..$#nm) { + isnt ($combos{$nm[$i]}, $combos{$nm[$j]}, + "results for $nm[$i] and $nm[$j] are different, as expected"); + } +} + +# add samples with switching styles & sticky modes +for $mode (@modes) { + walk_output(\$sample); + reset_sequence(); + $walker->($mode); + for $style (@styles) { + walk_output(\$sample); + reset_sequence(); + $walker->($style); + $combos{"$mode/$style"} = $sample; } +} +# test commutativity of flags, ie that AB == BA +for $mode (@modes) { + for $style (@styles) { + is ( $combos{"$style/$mode"}, + $combos{"$mode/$style"}, + "results for $style/$mode vs $mode/$style are the same" ); + } +} - #now do double crosschecks: commutativity across stick / nostick - %combos = (%combos, %save); +#now do double crosschecks: commutativity across stick / nostick +%combos = (%combos, %save); - # test commutativity of flags, ie that AB == BA - for $mode (@modes) { - for $style (@styles) { +# test commutativity of flags, ie that AB == BA +for $mode (@modes) { + for $style (@styles) { - is ( $combos{"$style$mode"}, - $combos{"$style/$mode"}, - "$style$mode VS $style/$mode are the same" ); + is ( $combos{"$style$mode"}, + $combos{"$style/$mode"}, + "$style$mode VS $style/$mode are the same" ); - is ( $combos{"$mode$style"}, - $combos{"$mode/$style"}, - "$mode$style VS $mode/$style are the same" ); + is ( $combos{"$mode$style"}, + $combos{"$mode/$style"}, + "$mode$style VS $mode/$style are the same" ); - is ( $combos{"$style$mode"}, - $combos{"$mode/$style"}, - "$style$mode VS $mode/$style are the same" ); + is ( $combos{"$style$mode"}, + $combos{"$mode/$style"}, + "$style$mode VS $mode/$style are the same" ); - is ( $combos{"$mode$style"}, - $combos{"$style/$mode"}, - "$mode$style VS $style/$mode are the same" ); - } + is ( $combos{"$mode$style"}, + $combos{"$style/$mode"}, + "$mode$style VS $style/$mode are the same" ); } } |