From f590c786936d3b7975111890d9bf851cffb732dc Mon Sep 17 00:00:00 2001 From: Reini Urban Date: Thu, 19 Nov 2015 14:44:45 +0100 Subject: [PATCH] C 1.52_22: save COP->hints_hash Fixes GH #220 move global state to save_context This has nothing to do in modules. But the cophh/B::RHE chain is not yet stored efficiently. Fixes t/testc.sh -q -k -O0 130 180 220 250 302 but broke 240 242 use open #31 not yet, i.e. $^H{open<} (cherry picked from commit 4ab03cca6779a7a46ed7a68a67b133ae41864ea1) Signed-off-by: Nicolas Rochelemagne --- C.xs | 7 ++++++ MANIFEST | 1 + lib/B/C.pm | 53 ++++++++++++++++++++++++++++----------- lib/B/C/OverLoad/B/COP.pm | 18 +++++++++++++ t/issue220.t | 26 +++++++++++++++++++ t/testc.sh | 13 +++++----- 6 files changed, 97 insertions(+), 21 deletions(-) create mode 100644 t/issue220.t diff --git a/C.xs b/C.xs index 37850a342..d5dc7aeb3 100644 --- a/C.xs +++ b/C.xs @@ -360,6 +360,13 @@ MODULE = B__C PACKAGE = B::C PROTOTYPES: DISABLE +SV* +hints_hash() +PPCODE: + HV* hv = cophh_2hv(CopHINTHASH_get(&PL_compiling), 0); + mPUSHs(newSVrv((SV*)hv, NULL)); + XSRETURN(1); + CV* method_cv(meth, packname) SV* meth; diff --git a/MANIFEST b/MANIFEST index 37e008805..3e26962c4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -127,6 +127,7 @@ t/issue208.t t/issue211.t t/issue212.t t/issue219.t +t/issue220.t t/issue229.t t/issue232.t t/issue234.t diff --git a/lib/B/C.pm b/lib/B/C.pm index 9bd016679..2f09474aa 100644 --- a/lib/B/C.pm +++ b/lib/B/C.pm @@ -1215,11 +1215,49 @@ sub make_c3 { init2()->add( sprintf( 'Perl_mro_set_mro(aTHX_ HvMROMETA(%s), newSVpvs("c3"));', savestashpv($package) ) ); } +# global state only, unneeded for modules sub save_context { # forbid run-time extends of curpad syms, names and INC verbose("save context:"); + my $warner = $SIG{__WARN__}; + B::C::Save::Signals::save($warner); # FIXME ? $warner seems useless arg to save_sig call + # honour -w and %^H + init()->add( "/* honor -w */", sprintf "PL_dowarn = ( %s ) ? G_WARN_ON : G_WARN_OFF;", $^W ); + if ( $^{TAINT} ) { + init()->add( + "/* honor -Tt */", + "PL_tainting = TRUE;", + "PL_taint_warn = " . ( $^{TAINT} < 0 ? "FALSE" : "TRUE" ) . ";" + ); # -T -1 false, -t 1 true + } + my $hints = hints_hash(); + + # XXX fake TESTING + #$^H{feature_say} = 1; + #$^H{dooot} = -42; + if ( $hints and %$hints ) { + init()->add("/* honor %^H */"); # hints hash in PL_hintgv, i.e CopHINTHASH(&PL_compiling) + # my $sym = B::svref_2object( \%^H )->save("main::\010"); + # $init->add("GvHV(PL_hintgv) = $sym;"); + # or store all keys dynamically: + for my $k ( keys %$hints ) { + my $v = $hints->{$k}; + my $sym = B::svref_2object( \$v )->save("\$^H{$k}"); + init()->add( + sprintf( + "CopHINTHASH_set(PL_curcop,\n" . "\t cophh_store_pvs(CopHINTHASH_get(PL_curcop), %s, %s, 0));", + cstring($k), $sym + ) + ); + + #or + # (void)hv_stores(GvHV(PL_hintgv), $k, $v); + # mg_set($v); + } + } + # need to mark assign c3 to %main::. no need to assign the default dfs if ( is_using_mro() && mro::get_mro("main") eq 'c3' ) { make_c3('main'); @@ -1354,21 +1392,6 @@ sub save_main_rest { B::C::Optimizer::UnusedPackages::optimize(); init()->add("/* done extras */"); - B::C::Save::Signals::save(); - - # honour -w - init()->add( - "/* honor -w */", - sprintf "PL_dowarn = %s;", $^W ? 'G_WARN_ON' : 'G_WARN_OFF' - ); - if ( $^{TAINT} ) { - init()->add( - "/* honor -Tt */", - "PL_tainting = TRUE;", - "PL_taint_warn = " . ( $^{TAINT} < 0 ? "FALSE" : "TRUE" ) . ";" - ); # -T -1 false, -t 1 true - } - # startpoints: XXX TODO push BEGIN/END blocks to modules code. debug( av => "Writing init_av" ); my $init_av = init_av->save('INIT'); diff --git a/lib/B/C/OverLoad/B/COP.pm b/lib/B/C/OverLoad/B/COP.pm index 3c2cd6df4..ee3e18a0c 100644 --- a/lib/B/C/OverLoad/B/COP.pm +++ b/lib/B/C/OverLoad/B/COP.pm @@ -113,6 +113,24 @@ sub save { my $ix = copsect()->index; init()->add( sprintf( "cop_list[%d].op_ppaddr = %s;", $ix, $op->ppaddr ) ) unless $B::C::optimize_ppaddr; + if ( $op->hints_hash ) { + + # TODO: cache those cophh RHE pointers + my $hints = $op->hints_hash; + $hints = $hints->HASH if ref $hints eq 'B::RHE'; + for my $k ( keys %$hints ) { + my $v = $hints->{$k}; + my $sym = B::svref_2object( \$v )->save("\$^H{$k}"); + + # if not utf8: + init()->add( + sprintf( + "CopHINTHASH_set(&cop_list[%d],\n" . "\t cophh_store_pvs(CopHINTHASH_get(&cop_list[%d]), %s, %s, 0));", + $ix, $ix, cstring($k), $sym + ) + ); + } + } if ( !$is_special and !$isint ) { my $copw = $warn_sv; $copw =~ s/^\(STRLEN\*\)&//; diff --git a/t/issue220.t b/t/issue220.t new file mode 100644 index 000000000..5a90c8e03 --- /dev/null +++ b/t/issue220.t @@ -0,0 +1,26 @@ +#! /usr/bin/env perl +# GH #220, COP->hints_hash +use strict; + +BEGIN { + unshift @INC, 't'; + require "test.pl"; +} +use Test::More tests => 1; +my $script = <<'EOF'; +BEGIN { $^H{dooot} = 1 } +sub hint_fetch { + my $key = shift; + my @results = caller(0); + $results[10]->{$key}; +} +print qq{ok\n} if hint_fetch("dooot"); +EOF + +use B::C (); +my $todo = ( $B::C::VERSION ge '1.52_22' ) ? "" : "TODO "; + +ctestok( + 1, 'C', 'ccode200i', $script, + $todo . '#200 hints hash saved' +); diff --git a/t/testc.sh b/t/testc.sh index ac5fb0708..c201c129e 100755 --- a/t/testc.sh +++ b/t/testc.sh @@ -898,13 +898,14 @@ tests[219]='package OverloadTest; use overload qw("") => sub { ${$_[0]} }; packa my $foo = bless \(my $bar = "ok"), "OverloadTest"; print $foo."\n";' tests[2190]='package Foo; use overload; sub import { overload::constant "integer" => sub { return shift }}; package main; BEGIN { $INC{"Foo.pm"} = "/lib/Foo.pm" }; use Foo; my $result = eval "5+6"; print "$result\n"' result[2190]='11' -# also at 904 -tests[220]=' -my $content = "ok\n"; -while ( $content =~ m{\w}g ) { - $_ .= "$-[0]$+[0]"; +# old issue 220 see 904 +tests[220]='BEGIN { $^H{dooot} = 1 } +sub hint_fetch { + my $key = shift; + my @results = caller(0); + $results[10]->{$key}; } -print "ok" if $_ eq "0112";' +print qq{ok\n} if hint_fetch("dooot");' tests[2231]='use strict; eval q({ $x = sub }); print $@' result[2231]='Illegal declaration of anonymous subroutine at (eval 1) line 1.' tests[222]='my $qr = qr/(?{<