This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove former SKIP blocks in ext/B/t/concise.t and re-indent
authorNicholas Clark <nick@ccl4.org>
Thu, 16 Sep 2021 10:40:27 +0000 (10:40 +0000)
committerNicholas Clark <nick@ccl4.org>
Thu, 16 Sep 2021 13:22:06 +0000 (13:22 +0000)
ext/B/t/concise.t

index 41ac70a..58d0103 100644 (file)
@@ -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" );
     }
 }