From: Jim Cromie 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)