From: Jim Cromie <jcromie@cpan.org>
Date: Sun, 1 Jan 2006 23:05:00 +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=d51cf0c98f3998b8619964692ede02a78dd26923;p=p5sagit%2Fp5-mst-13.2.git

Re: [patch] optimized constant subs are cool, teach B::Concise about them
Message-ID: <43B8C28C.20502@gmail.com>

p4raw-id: //depot/perl@26576
---

diff --git a/MANIFEST b/MANIFEST
index 6018a97..78436f4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -125,6 +125,7 @@ ext/B/Todo		Compiler backend Todo list
 ext/B/t/OptreeCheck.pm		optree comparison tool
 ext/B/t/optree_check.t		test OptreeCheck apparatus
 ext/B/t/optree_concise.t	more B::Concise tests
+ext/B/t/optree_constants.t	B::Concise rendering of optimized constant subs
 ext/B/t/optree_samples.t	various basic codes: if for while 
 ext/B/t/optree_sort.t		inplace sort optimization regression
 ext/B/t/optree_specials.t	BEGIN, END, etc code
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 9b44b05..ebacec3 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -163,6 +163,11 @@ sub concise_cv_obj {
     # name is either a string, or a CODE ref (copy of $cv arg??)
 
     $curcv = $cv;
+
+    if (ref($cv->XSUBANY) =~ /B::([INP]V)/) {
+	print $walkHandle "$name is a constant sub, optimized to a $1\n";
+	return;
+    }
     if ($cv->XSUB) {
 	print $walkHandle "$name is XS code\n";
 	return;
diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index b2b840b..c131436 100644
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -4,17 +4,41 @@
 
 =head1 SYNOPSIS
 
-To verify that B::Concise properly reports whether functions are XS or
-perl, we test against 2 (currently) core packages which have lots of
-XS functions: B and Digest::MD5.  They're listed in %$testpkgs, along
-with a list of functions that are (or are not) XS.  For brevity, you
-can specify the shorter list; if they're non-xs routines, start list
-with a '!'.  Data::Dumper is also tested, partly to prove the non-!
-usage.
-
-We demand-load each package, scan its stash for function names, and
-mark them as XS/not-XS according to the list given for each package.
-Then we test B::Concise's report on each.
+To verify that B::Concise properly reports whether functions are XS,
+perl, or optimized constant subs, we test against a few core packages
+which have a stable API, and which have functions of all 3 types.
+
+=head1 WHAT IS TESTED
+
+5 core packages are tested; Digest::MD5, B, B::Deparse, Data::Dumper,
+and POSIX.  These have a mix of the 3 expected implementation types;
+perl, XS, and constant (optimized constant subs).
+
+%$testpkgs specifies what packages are tested; each package is loaded,
+and the stash is scanned for the function-names in that package.
+
+Each value in %$testpkgs is a hash-of-lists (HoL) whose keys are
+implementation-types and values are lists of function-names of that type.
+
+To keep these HoLs smaller and more managable, they may carry an
+additional 'dflt' => $impl_Type, which means that unnamed functions
+are expected to be of that default implementation type.  Those unnamed
+functions are known from the scan of the package stash.
+
+=head1 HOW THEY'RE TESTED
+
+Each function is 'rendered' by B::Concise, and result is matched
+against regexs for each possible implementation-type.  For some
+packages, some functions may be unimplemented on some platforms.
+
+To slay this maintenance dragon, the regexs used in like() match
+against renderings which indicate that there is no implementation.
+
+If a function is implemented differently on different platforms, the
+test for that function will fail on one of those platforms.  These
+specific functions can be skipped by a 'skip' => [ @list ] to the HoL
+mentioned previously.  See usage for skip in B's HoL, which avoids
+testing a function which doesnt exist on non-threaded builds.
 
 =head1 OPTIONS AND ARGUMENTS
 
@@ -24,8 +48,9 @@ C<-a> uses Module::CoreList to run all core packages through the test, which
 gives some interesting results.
 
 C<-c> causes the expected XS/non-XS results to be marked with
-corrections, which are then reported at program END, in a
-Data::Dumper statement
+corrections, which are then reported at program END, in a form that's
+readily cut-and-pastable into this file.
+
 
 C<< -r <file> >> reads a file, as written by C<-c>, and adjusts the expected
 results accordingly.  The file is 'required', so @INC settings apply.
@@ -36,8 +61,6 @@ may be useful otherwise (ie just to see).
 
 =head1 EXAMPLES
 
-All following examples avoid using PERL_CORE=1, since that changes @INC
-
 =over 4
 
 =item ./perl -Ilib -wS ext/B/t/concise-xs.t -c Storable
@@ -92,40 +115,93 @@ BEGIN {
 
 use Getopt::Std;
 use Carp;
-use Test::More tests => ( 1 * !!$Config::Config{useithreads}
+use Test::More tests => ( 0 * !!$Config::Config{useithreads}
 			  + 3 * ($] > 5.009)
 			  + 14 * ($] >= 5.009003)
-			  + 780 );
+			  + 780 + 588 );
 
 require_ok("B::Concise");
 
-my $testpkgs = {
-
-    Digest::MD5 => [qw/ ! import /],
-
-    B => [qw/ ! class clearsym compile_stats debug objsym parents
-	      peekop savesym timing_info walkoptree_exec
-	      walkoptree_slow walksymtable /],
-
-    Data::Dumper => [qw/ bootstrap Dumpxs /],
-
-    B::Deparse => [qw/ ASSIGN CVf_ASSERTION CVf_LOCKED CVf_LVALUE
-		   CVf_METHOD LIST_CONTEXT OP_CONST OP_LIST OP_RV2SV
-		   OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL
-		   OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR
-		   OPf_WANT_VOID OPpCONST_ARYBASE OPpCONST_BARE
-		   OPpENTERSUB_AMPER OPpEXISTS_SUB OPpITER_REVERSED
-		   OPpLVAL_INTRO OPpOUR_INTRO OPpSLICE OPpSORT_DESCEND
-		   OPpSORT_INPLACE OPpSORT_INTEGER OPpSORT_NUMERIC
-		   OPpSORT_REVERSE OPpTARGET_MY OPpTRANS_COMPLEMENT
-		   OPpTRANS_DELETE OPpTRANS_SQUASH PMf_CONTINUE
-		   PMf_EVAL PMf_EXTENDED PMf_FOLD PMf_GLOBAL PMf_KEEP
-		   PMf_MULTILINE PMf_ONCE PMf_SINGLELINE PMf_SKIPWHITE
-		   POSTFIX SVf_FAKE SVf_IOK SVf_NOK SVf_POK SVf_ROK
-		   SVpad_OUR SVs_RMG SVs_SMG SWAP_CHILDREN main_cv
-		   main_root main_start opnumber perlstring
-		   svref_2object /],
+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/,
+);
 
+my $testpkgs = {
+    # packages to test, with expected types for named funcs
+
+    Digest::MD5 => { perl => [qw/ import /],
+		     dflt => 'XS' },
+
+    Data::Dumper => { XS => [qw/ bootstrap Dumpxs /],
+		      dflt => 'perl' },
+    B => { 
+	dflt => 'constant',		# all but 47/274
+	skip => [ 'regex_padav' ],	# threaded only
+	perl => [qw(
+		    walksymtable walkoptree_slow walkoptree_exec
+		    timing_info savesym peekop parents objsym debug
+		    compile_stats clearsym class
+		    )],
+	XS => [qw(
+		  warnhook walkoptree_debug walkoptree threadsv_names
+		  svref_2object sv_yes sv_undef sv_no save_BEGINs
+		  regex_padav ppname perlstring opnumber minus_c
+		  main_start main_root main_cv init_av inc_gv hash
+		  formfeed end_av dowarn diehook defstash curstash
+		  cstring comppadlist check_av cchar cast_I32 bootstrap
+		  begin_av amagic_generation address
+		  )],
+    },
+
+    B::Deparse => { dflt => 'perl',	# 235 functions
+
+	XS => [qw( svref_2object perlstring opnumber main_start
+		   main_root main_cv )],
+
+	constant => [qw/ ASSIGN CVf_ASSERTION CVf_LOCKED CVf_LVALUE
+		     CVf_METHOD LIST_CONTEXT OP_CONST OP_LIST OP_RV2SV
+		     OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL
+		     OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR
+		     OPf_WANT_VOID OPpCONST_ARYBASE OPpCONST_BARE
+		     OPpENTERSUB_AMPER OPpEXISTS_SUB OPpITER_REVERSED
+		     OPpLVAL_INTRO OPpOUR_INTRO OPpSLICE OPpSORT_DESCEND
+		     OPpSORT_INPLACE OPpSORT_INTEGER OPpSORT_NUMERIC
+		     OPpSORT_REVERSE OPpTARGET_MY OPpTRANS_COMPLEMENT
+		     OPpTRANS_DELETE OPpTRANS_SQUASH PMf_CONTINUE
+		     PMf_EVAL PMf_EXTENDED PMf_FOLD PMf_GLOBAL PMf_KEEP
+		     PMf_MULTILINE PMf_ONCE PMf_SINGLELINE PMf_SKIPWHITE
+		     POSTFIX SVf_FAKE SVf_IOK SVf_NOK SVf_POK SVf_ROK
+		     SVpad_OUR SVs_RMG SVs_SMG SWAP_CHILDREN
+		     /],
+		 },
+
+    POSIX => { dflt => 'constant',	# all but 252/589
+	       perl => [qw/ import croak AUTOLOAD /],
+
+	       XS => [qw/ write wctomb wcstombs uname tzset tzname
+		      ttyname tmpnam times tcsetpgrp tcsendbreak
+		      tcgetpgrp tcflush tcflow tcdrain tanh tan
+		      sysconf strxfrm strtoul strtol strtod
+		      strftime strcoll sinh sigsuspend sigprocmask
+		      sigpending sigaction setuid setsid setpgid
+		      setlocale setgid read pipe pause pathconf
+		      open nice modf mktime mkfifo mbtowc mbstowcs
+		      mblen lseek log10 localeconv ldexp lchown
+		      isxdigit isupper isspace ispunct isprint
+		      islower isgraph isdigit iscntrl isalpha
+		      isalnum int_macro_int getcwd frexp fpathconf
+		      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
+		      /],
+	       },
 };
 
 ############
@@ -142,7 +218,7 @@ usage: PERL_CORE=1 ./perl ext/B/t/concise-xs.t [-av] [module-list]
     -c  : writes test corrections as a Data::Dumper expression
     -r <file>	: reads file of tests, as written by -c
     <args>	: additional modules are loaded and tested
-    	(will report failures, since no XS funcs are known aprior)
+    	(will report failures, since no XS funcs are known apriori)
 
 EODIE
     ;
@@ -176,59 +252,60 @@ unless ($opts{a}) {
 ############
 
 sub test_pkg {
-    my ($pkg_name, $xslist) = @_;
-    require_ok($pkg_name);
+    my ($pkg, $fntypes) = @_;
+    require_ok($pkg);
 
-    unless (ref $xslist eq 'ARRAY') {
-	warn "no XS/non-XS function list given, assuming empty XS list";
-	$xslist = [''];
-    }
-
-    my $assumeXS = 0;	# assume list enumerates XS funcs, not perl ones
-    $assumeXS = 1	if $xslist->[0] and $xslist->[0] eq '!';
-
-    # build %stash: keys are func-names, vals: 1 if XS, 0 if not
+    # build %stash: keys are func-names, vals filled in below
     my (%stash) = map
-	( ($_ => $assumeXS)
-	  => ( grep exists &{"$pkg_name\::$_"}	# grab CODE symbols
+	( ($_ => 0)
+	  => ( grep exists &{"$pkg\::$_"}	# grab CODE symbols
 	       => grep !/__ANON__/		# but not anon subs
-	       => keys %{$pkg_name.'::'}	# from symbol table
+	       => keys %{$pkg.'::'}		# from symbol table
 	       ));
 
-    # now invert according to supplied list
-    $stash{$_} = int ! $assumeXS foreach @$xslist;
-
-    # and cleanup cruft (easier than preventing)
-    delete @stash{'!',''};
+    for my $type (keys %matchers) {
+	foreach my $fn (@{$fntypes->{$type}}) {
+	    carp "$fn can only be one of $type, $stash{$fn}\n"
+		if $stash{$fn};
+	    $stash{$fn} = $type;
+	}
+    }
+    # set default type for un-named functions
+    my $dflt = $fntypes->{dflt} || 'perl';
+    for my $k (keys %stash) {
+	$stash{$k} = $dflt unless $stash{$k};
+    }
+    $stash{$_} = 'skip' foreach @{$fntypes->{skip}};
 
     if ($opts{v}) {
-	diag("xslist: " => Dumper($xslist));
-	diag("$pkg_name stash: " => Dumper(\%stash));
+	diag("fntypes: " => Dumper($fntypes));
+	diag("$pkg stash: " => Dumper(\%stash));
     }
-    my $err;
-    foreach $func_name (reverse sort keys %stash) {
-	my $res = checkXS("${pkg_name}::$func_name", $stash{$func_name});
-	if (!$res) {
-	    $stash{$func_name} ^= 1;
-	    print "$func_name ";
-	    $err++;
+    foreach my $fn (reverse sort keys %stash) {
+	next if $stash{$fn} eq 'skip';
+	my $res = checkXS("${pkg}::$fn", $stash{$fn});
+	if ($res ne '1') {
+	    push @{$report{$pkg}{$res}}, $fn;
 	}
     }
-    $report{$pkg_name} = \%stash if $opts{c} and $err || $opts{v};
 }
 
 sub checkXS {
-    my ($func_name, $wantXS) = @_;
+    my ($func_name, $want) = @_;
+
+    croak "unknown type $want: $func_name\n"
+	unless defined $matchers{$want};
 
     my ($buf, $err) = render($func_name);
-    if ($wantXS) {
-	like($buf, qr/\Q$func_name is XS code/,
-	     "XS code:\t $func_name");
-    } else {
-	unlike($buf, qr/\Q$func_name is XS code/,
-	       "perl code:\t $func_name");
+    my $res = like($buf, $matchers{$want}, "$want sub:\t $func_name");
+
+    unless ($res) {
+	# test failed. return type that would give success
+	for my $m (keys %matchers) {
+	    return $m if $buf =~ $matchers{$m};
+	}
     }
-    #returns like or unlike, whichever was called
+    $res;
 }
 
 sub render {
@@ -246,7 +323,6 @@ sub render {
 }
 
 sub corecheck {
-
     eval { require Module::CoreList };
     if ($@) {
 	warn "Module::CoreList not available on $]\n";
@@ -263,21 +339,15 @@ sub corecheck {
 
 END {
     if ($opts{c}) {
-	# print "Corrections: ", Dumper(\%report);
-	print "# Tested Package Subroutines, 1's are XS, 0's are perl\n";
-	print "\$VAR1 = {\n";
+	$Data::Dumper::Indent = 1;
+	print "Corrections: ", Dumper(\%report);
 
 	foreach my $pkg (sort keys %report) {
-	    my (@xs, @perl);
-	    my $stash = $report{$pkg};
-
-	    @xs   = sort grep $stash->{$_} == 1, keys %$stash;
-	    @perl = sort grep $stash->{$_} == 0, keys %$stash;
-
-	    my @list = (@xs > @perl) ? ( '!', @perl) : @xs;
-	    print "\t$pkg => [qw/ @list /],\n";
+	    for my $type (keys %matchers) {
+		print "$pkg: $type: @{$report{$pkg}{$type}}\n"
+		    if @{$report{$pkg}{$type}};
+	    }
 	}
-	print "};\n";
     }
 }
 
diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
new file mode 100644
index 0000000..1abe759
--- /dev/null
+++ b/ext/B/t/optree_constants.t
@@ -0,0 +1,338 @@
+#!perl
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	chdir('t') if -d 't';
+	@INC = ('.', '../lib', '../ext/B/t');
+    } else {
+	unshift @INC, 't';
+	push @INC, "../../t";
+    }
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+    # require 'test.pl'; # now done by OptreeCheck
+}
+
+use OptreeCheck;	# ALSO DOES @ARGV HANDLING !!!!!!
+use Config;
+
+my $tests = 18;
+plan tests => $tests;
+SKIP: {
+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 },
+};
+
+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 ();";
+
+
+# should be able to undefine constant::import here ???
+INIT { 
+    # eval 'sub constant::import () {}';
+    # undef *constant::import::{CODE};
+};
+
+#################################
+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,
+	      todo	=> '- currently renders as XS code',
+	      noanchors => 1,
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+ is XS code
+EOT_EOT
+ is XS code
+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
+EOT_EOT
+ is XS code
+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
+EOT_EOT
+ is XS code
+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
+EOT_EOT
+ is XS code
+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
+
+
+checkOptree ( name	=> 'call myfl',
+	      code	=> 'myfl',
+	      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[NV 3.14159] 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(NV 3.14159) 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
+
+
+##################
+
+# test constant sub defined w/o 'use constant'
+
+checkOptree ( name	=> "pi(), defined w/o 'use constant'",
+	      code	=> \&pi,
+	      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	=> 'constant subs returning lists are not optimized',
+	      code	=> \&WEEKDAYS,
+	      noanchors => 1,
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
+# -     <@> lineseq K ->3
+# 1        <;> nextstate(constant 685 constant.pm:121) v ->2
+# 2        <0> padav[@list:FAKE:m:102] ->3
+EOT_EOT
+# 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
+# -     <@> lineseq K ->3
+# 1        <;> nextstate(constant 685 constant.pm:121) v ->2
+# 2        <0> padav[@list:FAKE:m:76] ->3
+EONT_EONT
+
+
+sub printem {
+    printf "myint %d mystr %s myfl %f pi %f\n"
+	, myint, mystr, myfl, pi;
+}
+
+checkOptree ( name	=> 'call em all in a print statement',
+	      code	=> \&printem,
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->9
+# 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
+# 8        <@> prtf sK ->9
+# 2           <0> pushmark s ->3
+# 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
+# 7           <$> const[NV 3.14159] s ->8
+EOT_EOT
+# 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->9
+# 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
+# 8        <@> prtf sK ->9
+# 2           <0> pushmark s ->3
+# 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
+# 7           <$> const(NV 3.14159) s ->8
+EONT_EONT
+
+
+} #skip
+
+__END__
+
+=head NB
+
+Optimized constant subs are stored as bare scalars in the stash
+(package hash), which formerly held only GVs (typeglobs).
+
+But you cant create them manually - you cant assign a scalar to a
+stash element, and expect it to work like a constant-sub, even if you
+provide a prototype.
+
+This is a feature; alternative is too much action-at-a-distance.  The
+following test demonstrates - napier is not seen as a function at all,
+much less an optimized one.
+
+=cut
+
+checkOptree ( name	=> 'not evertnapier',
+	      code	=> \&napier,
+	      noanchors => 1,
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+ has no START
+EOT_EOT
+ has no START
+EONT_EONT
+
+