C 1.52_22: save COP->hints_hash

Fixes GH rurban#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 4ab03cc)
Signed-off-by: Nicolas Rochelemagne <rochelemagne@cpanel.net>

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;

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

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');

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\*\)&//;

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'
+);

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/(?{<<END})/;