This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [patch] optimized constant subs are cool, teach B::Concise about them
authorJim Cromie <jcromie@cpan.org>
Tue, 3 Jan 2006 23:18:09 +0000 (16:18 -0700)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Wed, 4 Jan 2006 16:50:47 +0000 (16:50 +0000)
Message-ID: <43BB68A1.7060708@gmail.com>

With syntactic tweaks to the test file

p4raw-id: //depot/perl@26651

ext/B/B/Concise.pm
ext/B/t/concise-xs.t
ext/B/t/optree_constants.t

index c8710ca..5ce1d45 100644 (file)
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.66";
+our $VERSION   = "0.67";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main
@@ -950,9 +950,8 @@ sophisticated and flexible.
 
 =head1 EXAMPLE
 
-Here's an example of 2 outputs (aka 'renderings'), using the
--exec and -basic (i.e. default) formatting conventions on the same code
-snippet.
+Here's two outputs (or 'renderings'), using the -exec and -basic
+(i.e. default) formatting conventions on the same code snippet.
 
     % perl -MO=Concise,-exec -e '$a = $b + 42'
     1  <0> enter
@@ -964,21 +963,22 @@ snippet.
     7  <2> sassign vKS/2
     8  <@> leave[1 ref] vKP/REFC
 
-Each line corresponds to an opcode. The opcode marked with '*' is used
-in a few examples below.
+In this -exec rendering, each opcode is executed in the order shown.
+The add opcode, marked with '*', is discussed in more detail.
 
 The 1st column is the op's sequence number, starting at 1, and is
-displayed in base 36 by default.  This rendering is in -exec (i.e.
-execution) order.
+displayed in base 36 by default.  Here they're purely linear; the
+sequences are very helpful when looking at code with loops and
+branches.
 
 The symbol between angle brackets indicates the op's type, for
 example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is
 used in threaded perls. (see L</"OP class abbreviations">).
 
-The opname, as in B<'add[t1]'>, which may be followed by op-specific
+The opname, as in B<'add[t1]'>, may be followed by op-specific
 information in parentheses or brackets (ex B<'[t1]'>).
 
-The op-flags (ex B<'sK/2'>) follow, and are described in (L</"OP flags
+The op-flags (ex B<'sK/2'>) are described in (L</"OP flags
 abbreviations">).
 
     % perl -MO=Concise -e '$a = $b + 42'
@@ -1496,6 +1496,40 @@ The numeric value of the OP's type, in decimal.
 
 =back
 
+=head1 One-Liner Command tips
+
+=over 4
+
+=item perl -MO=Concise,bar foo.pl
+
+Renders only bar() from foo.pl.  To see main, drop the ',bar'.  To see
+both, add ',-main'
+
+=item perl -MDigest::MD5=md5 -MO=Concise,md5 -e1
+
+Identifies md5 as an XS function.  The export is needed so that BC can
+find it in main.
+
+=item perl -MPOSIX -MO=Concise,_POSIX_ARG_MAX -e1
+
+Identifies _POSIX_ARG_MAX as a constant sub, optimized to an IV.
+Although POSIX isn't entirely consistent across platforms, this is
+likely to be present in virtually all of them.
+
+=item perl -MPOSIX -MO=Concise,a -e 'print _POSIX_SAVED_IDS'
+
+This renders a print statement, which includes a call to the function.
+It's identical to rendering a file with a use call and that single
+statement, except for the filename which appears in the nextstate ops.
+
+=item perl -MPOSIX -MO=Concise,a -e 'sub a{_POSIX_SAVED_IDS}'
+
+This is B<very> similar to previous, only the first two ops differ.  This
+subroutine rendering is more representative, insofar as a single main
+program will have many subs.
+
+
+
 =head1 Using B::Concise outside of the O framework
 
 The common (and original) usage of B::Concise was for command-line
index a90a615..fa0e7df 100644 (file)
@@ -118,7 +118,7 @@ use Carp;
 use Test::More tests => ( # per-pkg tests (function ct + require_ok)
                          40 + 16       # Data::Dumper, Digest::MD5
                          + 511 + 233   # B::Deparse, B
-                         + 589 + 189   # POSIX, IO::Socket
+                         + 588 + 189   # POSIX, IO::Socket
                          + 3 * ($] > 5.009)
                          + 14 * ($] >= 5.009003)
                          - 22);        # fudge
@@ -182,7 +182,8 @@ my $testpkgs = {
                     /],
                 },
 
-    POSIX => { dflt => 'constant',     # all but 252/589
+    POSIX => { dflt => 'constant',                     # all but 252/589
+              skip => [qw/ _POSIX_JOB_CONTROL /],      # platform varying
               perl => [qw/ import croak AUTOLOAD /],
 
               XS => [qw/ write wctomb wcstombs uname tzset tzname
index 49243f5..453eed0 100644 (file)
@@ -19,7 +19,7 @@ BEGIN {
 use OptreeCheck;       # ALSO DOES @ARGV HANDLING !!!!!!
 use Config;
 
-my $tests = 23;
+my $tests = 30;
 plan tests => $tests;
 SKIP: {
 skip "no perlio in this build", $tests unless $Config::Config{useperlio};
@@ -27,23 +27,44 @@ skip "no perlio in this build", $tests unless $Config::Config{useperlio};
 #################################
 
 use constant {         # see also t/op/gv.t line 282
-    myint => 42,
-    mystr => 'hithere',
-    myfl => 3.14159,
-    myrex => qr/foo/,
-    myglob => \*STDIN,
-    myaref => [ 1,2,3 ],
-    myhref => { a => 1 },
-    myundef => undef,
-    mysub => \&ok,
-    mysub => \&nosuch,
+    myaref     => [ 1,2,3 ],
+    myfl       => 1.414213,
+    myglob     => \*STDIN,
+    myhref     => { a  => 1 },
+    myint      => 42,
+    myrex      => qr/foo/,
+    mystr      => 'hithere',
+    mysub      => \&ok,
+    myundef    => undef,
+    myunsub    => \&nosuch,
+};
+
+sub myyes() { 1==1 }
+sub myno () { return 1!=1 }
+sub pi () { 3.14159 };
+
+my $want = {   # expected types, how value renders in-line, todos (maybe)
+    myfl       => [ 'NV', myfl ],
+    myint      => [ 'IV', myint ],
+    mystr      => [ 'PV', '"'.mystr.'"' ],
+    myhref     => [ 'RV', '\\\\HASH'],
+    myundef    => [ 'NULL', ],
+    pi         => [ 'NV', pi ],
+    # these have todos, since they render as a bare backslash
+    myaref     => [ 'RV', '\\\\', ' - should render as \\ARRAY' ],
+    myglob     => [ 'RV', '\\\\', ' - should render as \\GV' ],
+    myrex      => [ 'RV', '\\\\', ' - should render as ??' ],
+    mysub      => [ 'RV', '\\\\', ' - should render as \\CV' ],
+    myunsub    => [ 'RV', '\\\\', ' - should render as \\CV' ],
+    # these are not inlined, at least not per BC::Concise
+    #myyes     => [ 'RV', ],
+    #myno      => [ 'RV', ],
 };
 
 use constant WEEKDAYS
     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
 
 
-sub pi () { 3.14159 };
 $::{napier} = \2.71828;        # counter-example (doesn't get optimized).
 eval "sub napier ();";
 
@@ -55,268 +76,94 @@ INIT {
 };
 
 #################################
-pass("CONSTANT SUBS RETURNING SCALARS");
-
-checkOptree ( name     => 'myint() as coderef',
-             code      => \&myint,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a IV
-EOT_EOT
- is a constant sub, optimized to a IV
-EONT_EONT
-
-
-checkOptree ( name     => 'mystr() as coderef',
-             code      => \&mystr,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a PV
-EOT_EOT
- is a constant sub, optimized to a PV
-EONT_EONT
-
-
-checkOptree ( name     => 'myfl() as coderef',
-             code      => \&myfl,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a NV
-EOT_EOT
- is a constant sub, optimized to a NV
-EONT_EONT
-
-
-checkOptree ( name     => 'myrex() as coderef',
-             code      => \&myrex,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a RV
-EOT_EOT
- is a constant sub, optimized to a RV
-EONT_EONT
-
-
-checkOptree ( name     => 'myglob() as coderef',
-             code      => \&myglob,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a RV
-EOT_EOT
- is a constant sub, optimized to a RV
-EONT_EONT
-
-
-checkOptree ( name     => 'myaref() as coderef',
-             code      => \&myaref,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a RV
-EOT_EOT
- is a constant sub, optimized to a RV
-EONT_EONT
-
-
-checkOptree ( name     => 'myhref() as coderef',
-             code      => \&myhref,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a RV
-EOT_EOT
- is a constant sub, optimized to a RV
-EONT_EONT
-
-
-checkOptree ( name     => 'myundef() as coderef',
-             code      => \&myundef,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a NULL
-EOT_EOT
- is a constant sub, optimized to a NULL
-EONT_EONT
-
-
-checkOptree ( name     => 'mysub() as coderef',
-             code      => \&mysub,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a RV
-EOT_EOT
- is a constant sub, optimized to a RV
-EONT_EONT
-
+pass("RENDER CONSTANT SUBS RETURNING SCALARS");
 
-checkOptree ( name     => 'myunsub() as coderef',
-             todo      => '- may prove only that sub is unformed',
-             code      => \&myunsub,
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- has no START
+for $func (sort keys %$want) {
+    # no strict 'refs';        # why not needed ?
+    checkOptree ( name      => "$func() as a coderef",
+                 code      => \&{$func},
+                 noanchors => 1,
+                 expect    => <<EOT_EOT, expect_nt => <<EONT_EONT);
+ is a constant sub, optimized to a $want->{$func}[0]
 EOT_EOT
- has no START
+ is a constant sub, optimized to a $want->{$func}[0]
 EONT_EONT
 
+}
 
-##############
-
-checkOptree ( name     => 'call myint',
-             code      => 'myint',
-             bc_opts   => '-nobanner',
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-3  <1> leavesub[2 refs] K/REFC,1 ->(end)
--     <@> lineseq KP ->3
-1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
-2        <$> const[IV 42] s ->3
-EOT_EOT
-3  <1> leavesub[2 refs] K/REFC,1 ->(end)
--     <@> lineseq KP ->3
-1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
-2        <$> const(IV 42) s ->3
-EONT_EONT
-
-
-checkOptree ( name     => 'call mystr',
-             code      => 'mystr',
-             bc_opts   => '-nobanner',
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-3  <1> leavesub[2 refs] K/REFC,1 ->(end)
--     <@> lineseq KP ->3
-1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
-2        <$> const[PV "hithere"] s ->3
-EOT_EOT
-3  <1> leavesub[2 refs] K/REFC,1 ->(end)
--     <@> lineseq KP ->3
-1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
-2        <$> const(PV "hithere") s ->3
-EONT_EONT
-
+pass("RENDER CALLS TO THOSE CONSTANT SUBS");
 
-checkOptree ( name     => 'call myfl',
-             code      => 'myfl',
-             bc_opts   => '-nobanner',
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+for $func (sort keys %$want) {
+    # print "# doing $func\n";
+    checkOptree ( name    => "call $func",
+                 code    => "$func",
+                 ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
+                 bc_opts => '-nobanner',
+                 expect  => <<EOT_EOT, expect_nt => <<EONT_EONT);
 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
--     <@> lineseq KP ->3
+-     <\@> lineseq KP ->3
 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
-2        <$> const[NV 3.14159] s ->3
+2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
 EOT_EOT
 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
--     <@> lineseq KP ->3
+-     <\@> lineseq KP ->3
 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
-2        <$> const(NV 3.14159) s ->3
+2        <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
 EONT_EONT
 
+}
 
-checkOptree ( name     => 'call myrex',
-             code      => 'myrex',
-             todo      => '- RV value is bare backslash',
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 753 (eval 27):1) v ->2
-# 2        <$> const[RV \\] s ->3
-EOT_EOT
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 753 (eval 27):1) v ->2
-# 2        <$> const(RV \\) s ->3
-EONT_EONT
-
-
-checkOptree ( name     => 'call myglob',
-             code      => 'myglob',
-             todo      => '- RV value is bare backslash',
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 753 (eval 27):1) v ->2
-# 2        <$> const[RV \\] s ->3
-EOT_EOT
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 753 (eval 27):1) v ->2
-# 2        <$> const(RV \\) s ->3
-EONT_EONT
-
-
-checkOptree ( name     => 'call myaref',
-             code      => 'myaref',
-             todo      => '- RV value is bare backslash',
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 758 (eval 29):1) v ->2
-# 2        <$> const[RV \\] s ->3
-EOT_EOT
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 758 (eval 29):1) v ->2
-# 2        <$> const(RV \\) s ->3
-EONT_EONT
-
-
-checkOptree ( name     => 'call myhref',
-             code      => 'myhref',
-             noanchors => 1,
-             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 763 (eval 31):1) v ->2
-# 2        <$> const[RV \\HASH] s ->3
-EOT_EOT
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 763 (eval 31):1) v ->2
-# 2        <$> const(RV \\HASH) s ->3
-EONT_EONT
-
+##############
+pass("MORE TESTS");
 
-checkOptree ( name     => 'call myundef',
-             code      => 'myundef',
+checkOptree ( name     => 'myyes() as coderef',
+             code      => sub () { 1==1 },
              noanchors => 1,
              expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 771 (eval 35):1) v ->2
-# 2        <$> const[NULL ] s ->3
+ is a constant sub, optimized to a SPECIAL
 EOT_EOT
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 771 (eval 35):1) v ->2
-# 2        <$> const(NULL ) s ->3
+ is a constant sub, optimized to a SPECIAL
 EONT_EONT
 
 
-checkOptree ( name     => 'call mysub',
-             code      => 'mysub',
+checkOptree ( name     => 'myyes() as coderef',
+             code      => 'sub a() { 1==1 }; print a',
              noanchors => 1,
              expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 771 (eval 35):1) v ->2
-# 2        <$> const[RV \\] s ->3
+# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->5
+# 1        <;> nextstate(main 810 (eval 47):1) v ->2
+# 4        <@> print sK ->5
+# 2           <0> pushmark s ->3
+# 3           <$> const[SPECIAL sv_yes] s ->4
 EOT_EOT
-# 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-# -     <@> lineseq KP ->3
-# 1        <;> nextstate(main 771 (eval 35):1) v ->2
-# 2        <$> const(RV \\) s ->3
+# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->5
+# 1        <;> nextstate(main 810 (eval 47):1) v ->2
+# 4        <@> print sK ->5
+# 2           <0> pushmark s ->3
+# 3           <$> const(SPECIAL sv_yes) s ->4
 EONT_EONT
 
-##################
 
-# test constant sub defined w/o 'use constant'
-
-checkOptree ( name     => "pi(), defined w/o 'use constant'",
-             code      => \&pi,
+checkOptree ( name     => 'myno() as coderef',
+             code      => 'sub a() { 1!=1 }; print a',
              noanchors => 1,
+             todo      => '- SPECIAL sv_no renders as PVNV 0',
              expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is a constant sub, optimized to a NV
+# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->5
+# 1        <;> nextstate(main 810 (eval 47):1) v ->2
+# 4        <@> print sK ->5
+# 2           <0> pushmark s ->3
+# 3           <$> const[PVNV 0] s ->4
 EOT_EOT
- is a constant sub, optimized to a NV
+# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->5
+# 1        <;> nextstate(main 810 (eval 47):1) v ->2
+# 4        <@> print sK ->5
+# 2           <0> pushmark s ->3
+# 3           <$> const(PVNV 0) s ->4
 EONT_EONT
 
 
@@ -352,7 +199,7 @@ checkOptree ( name  => 'call many in a print statement',
 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
 # 4           <$> const[IV 42] s ->5
 # 5           <$> const[PV "hithere"] s ->6
-# 6           <$> const[NV 3.14159] s ->7
+# 6           <$> const[NV 1.414213] s ->7
 # 7           <$> const[NV 3.14159] s ->8
 EOT_EOT
 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
@@ -363,7 +210,7 @@ EOT_EOT
 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
 # 4           <$> const(IV 42) s ->5
 # 5           <$> const(PV "hithere") s ->6
-# 6           <$> const(NV 3.14159) s ->7
+# 6           <$> const(NV 1.414213) s ->7
 # 7           <$> const(NV 3.14159) s ->8
 EONT_EONT