summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2021-09-16 10:40:27 +0000
committerNicholas Clark <nick@ccl4.org>2021-09-16 13:22:06 +0000
commit7961cfc17f76e7d41ff840ad69746d54922bffe9 (patch)
tree744b5dd2d5d6ecf4244dda91c6b8e671d5b24f0d /ext
parent66e1ef42e57482043a617e825835d1ded9ac5d3e (diff)
downloadperl-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.t404
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', \&not_even_declared);
- like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/,
- "'\&not_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', \&not_even_declared);
+ like ($res, qr/coderef CODE\(0x[0-9a-fA-F]+\) has no START/,
+ "'\&not_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" );
}
}