From: Jim Cromie <jcromie@cpan.org>
Date: Mon, 2 Jan 2006 15:06:48 +0000 (-0700)
Subject: Re: [patch] optimized constant subs are cool, teach B::Concise about them
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2018a5c31a07546d28320839d66a2fd3f203fa85;p=p5sagit%2Fp5-mst-13.2.git
Re: [patch] optimized constant subs are cool, teach B::Concise about them
Message-ID: <43B9A3F8.8060609@gmail.com>
p4raw-id: //depot/perl@26595
---
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index ebacec3..c8710ca 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -164,7 +164,7 @@ sub concise_cv_obj {
$curcv = $cv;
- if (ref($cv->XSUBANY) =~ /B::([INP]V)/) {
+ if (ref($cv->XSUBANY) =~ /B::(\w+)/) {
print $walkHandle "$name is a constant sub, optimized to a $1\n";
return;
}
diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index c131436..a90a615 100644
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -115,21 +115,22 @@ BEGIN {
use Getopt::Std;
use Carp;
-use Test::More tests => ( 0 * !!$Config::Config{useithreads}
+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
+ 3 * ($] > 5.009)
+ 14 * ($] >= 5.009003)
- + 780 + 588 );
+ - 22); # fudge
require_ok("B::Concise");
my %matchers =
( constant => qr{ (?-x: is a constant sub, optimized to a \w+)
|(?-x: exists in stash, but has no START) }x,
- XS => qr{ (?-x: is XS code)
- |(?-x: exists in stash, but has no START) }x,
- perl => qr{ (?-x: (next|db)state)
- |(?-x: exists in stash, but has no START) }x,
- noSTART => qr/exists in stash, but has no START/,
+ XS => qr/ is XS code/,
+ perl => qr/ (next|db)state/,
+ noSTART => qr/ exists in stash, but has no START/,
);
my $testpkgs = {
@@ -199,9 +200,26 @@ my $testpkgs = {
fmod floor dup2 dup difftime cuserid ctime
ctermid cosh constant close clock ceil
bootstrap atan asin asctime acos access abort
- _exit _POSIX_SAVED_IDS _POSIX_JOB_CONTROL
+ _exit
/],
},
+
+ IO::Socket => { dflt => 'constant', # 157/188
+
+ perl => [qw/ timeout socktype sockopt sockname
+ socketpair socket sockdomain sockaddr_un
+ sockaddr_in shutdown setsockopt send
+ register_domain recv protocol peername
+ new listen import getsockopt croak
+ connected connect configure confess close
+ carp bind atmark accept
+ /],
+
+ XS => [qw/ unpack_sockaddr_un unpack_sockaddr_in
+ sockatmark sockaddr_family pack_sockaddr_un
+ pack_sockaddr_in inet_ntoa inet_aton
+ /],
+ },
};
############
diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index 1abe759..49243f5 100644
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -19,7 +19,7 @@ BEGIN {
use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
use Config;
-my $tests = 18;
+my $tests = 23;
plan tests => $tests;
SKIP: {
skip "no perlio in this build", $tests unless $Config::Config{useperlio};
@@ -34,6 +34,9 @@ use constant { # see also t/op/gv.t line 282
myglob => \*STDIN,
myaref => [ 1,2,3 ],
myhref => { a => 1 },
+ myundef => undef,
+ mysub => \&ok,
+ mysub => \&nosuch,
};
use constant WEEKDAYS
@@ -86,45 +89,72 @@ EONT_EONT
checkOptree ( name => 'myrex() as coderef',
code => \&myrex,
- todo => '- currently renders as XS code',
noanchors => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is XS code
+ is a constant sub, optimized to a RV
EOT_EOT
- is XS code
+ is a constant sub, optimized to a RV
EONT_EONT
checkOptree ( name => 'myglob() as coderef',
code => \&myglob,
- todo => '- currently renders as XS code',
noanchors => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is XS code
+ is a constant sub, optimized to a RV
EOT_EOT
- is XS code
+ is a constant sub, optimized to a RV
EONT_EONT
checkOptree ( name => 'myaref() as coderef',
code => \&myaref,
- todo => '- currently renders as XS code',
noanchors => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is XS code
+ is a constant sub, optimized to a RV
EOT_EOT
- is XS code
+ is a constant sub, optimized to a RV
EONT_EONT
checkOptree ( name => 'myhref() as coderef',
code => \&myhref,
- todo => '- currently renders as XS code',
noanchors => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
- is XS code
+ is a constant sub, optimized to a RV
EOT_EOT
- is XS code
+ 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
+
+
+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
+EOT_EOT
+ has no START
EONT_EONT
@@ -245,6 +275,37 @@ EOT_EOT
EONT_EONT
+checkOptree ( name => 'call myundef',
+ code => 'myundef',
+ 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
+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
+EONT_EONT
+
+
+checkOptree ( name => 'call mysub',
+ code => 'mysub',
+ 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
+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
+EONT_EONT
+
##################
# test constant sub defined w/o 'use constant'
@@ -259,7 +320,7 @@ EOT_EOT
EONT_EONT
-checkOptree ( name => 'constant subs returning lists are not optimized',
+checkOptree ( name => 'constant sub returning list',
code => \&WEEKDAYS,
noanchors => 1,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
@@ -280,7 +341,7 @@ sub printem {
, myint, mystr, myfl, pi;
}
-checkOptree ( name => 'call em all in a print statement',
+checkOptree ( name => 'call many in a print statement',
code => \&printem,
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)