Skip to content

Commit

Permalink
C: fix overload stringify
Browse files Browse the repository at this point in the history 
and fix -DMG issues with wrong CV stashes.
Harmonize gv_stashpv, always using const strings.
Also force saving the @isa before calling gv_stashpvn()
so that gv_stashpvn can correctly populate its stashcache.
Fixes GH #219 for 5.18-5.22
  • Loading branch information
Reini Urban committed Nov 10, 2015
1 parent dd325a8 commit dbfa262
Show file tree
Hide file tree
Showing 2 changed files with 49 additions and 28 deletions.
73 changes: 48 additions & 25 deletions lib/B/C.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -793,20 +793,30 @@ sub strlen_flags {
}

sub savestash_flags {
my ($pv, $len, $flags) = @_;
return $stashtable{$pv} if defined $stashtable{$pv};
my ($name, $cstring, $len, $flags) = @_;
return $stashtable{$name} if exists $stashtable{$name};
#return '&PL_sv_undef' if $pv =~ /^B::CC?$/;
$flags = $flags ? "$flags|GV_ADD" : "GV_ADD";
my $sym = "hv$hv_index";
$decl->add("Static HV *hv$hv_index;");
my $pvok = $pv eq '0' || !$len ? q{""} : $pv;
$init->add( sprintf( "%s = gv_stashpvn(%s, %u, %s);", $sym, $pvok, $len, $flags));
$stashtable{$name} = $sym;
if ($PERL518 and $name) { # since 5.18 save @ISA before calling stashpv
my @isa = get_isa($name);
no strict 'refs';
if (@isa and exists ${$name.'::'}{ISA} ) {
svref_2object( \@{"$name\::ISA"} )->save("$name\::ISA");
}
}
my $pvsym = constpv($name);
$init->add( sprintf( "%s = gv_stashpvn(%s, %u, %s); /* $name */",
$sym, $pvsym, $len, $flags));
$hv_index++;
return $stashtable{$pv} = $sym;
return $sym;
}

sub savestashpv {
return savestash_flags(strlen_flags(shift));
my $name = shift;
return savestash_flags($name, strlen_flags($name));
}

sub savere {
Expand Down Expand Up @@ -2240,20 +2250,16 @@ sub B::COP::save {
}
#push @B::C::static_free, "cop_list[$ix]" if $ITHREADS;
if (!$B::C::optimize_cop) {
my $stash = savestashpv($op->stashpv);
if (!$ITHREADS) {
if ($B::C::const_strings) {
my ($pv, $cur, $flags) = strlen_flags($op->stashpv);
my $stash = savestash_flags(constpv($op->stashpv), $cur, $flags);
my $file = constpv($file);
$init->add(sprintf( "CopSTASH_set(&cop_list[%d], %s);", $ix, $stash ),
sprintf( "CopFILE_set(&cop_list[%d], %s);", $ix, $file ));
sprintf( "CopFILE_set(&cop_list[%d], %s);", $ix, constpv($file) ));
} else {
my $stash = savestashpv($op->stashpv);
$init->add(sprintf( "CopSTASH_set(&cop_list[%d], %s);", $ix, $stash),
sprintf( "CopFILE_set(&cop_list[%d], %s);", $ix, cstring($file) ));
}
} else { # cv_undef e.g. in bproto.t and many more core tests with threads
my $stash = savestashpv($op->stashpv);
$init->add(sprintf( "CopSTASH_set(&cop_list[%d], %s);", $ix, $stash ),
sprintf( "CopFILE_set(&cop_list[%d], %s);", $ix, cstring($file) ));
}
Expand Down Expand Up @@ -3276,6 +3282,7 @@ sub B::PVMG::save_magic {
my ($sv, $fullname) = @_;
my $sv_flags = $sv->FLAGS;
my $pkg;
return if $fullname eq '%B::C::';
if ($debug{mg}) {
my $flagspv = "";
$fullname = '' unless $fullname;
Expand All @@ -3296,26 +3303,37 @@ sub B::PVMG::save_magic {
warn sprintf("skip SvSTASH for %s flags=0x%x\n", $fullname, $sv->FLAGS)
if $verbose;
} else {
my $pkgsym;
$pkg = $sv->SvSTASH;
if ($pkg and $$pkg) {
warn sprintf("stash isa class(\"%s\") 0x%x\n", $pkg->NAME, $$pkg)
my $pkgname = $pkg->can('NAME') ? $pkg->NAME : $pkg->NAME_HEK."::DESTROY";
warn sprintf("stash isa class \"%s\" (%s)\n", $pkgname, ref $pkg)
if $debug{mg} or $debug{gv};
# 361 do not force dynaloading IO via IO::Handle upon us
# core already initialized this stash for us
unless ($fullname eq 'main::STDOUT' and $] >= 5.018) {
$pkg->save($fullname);
if (ref $pkg eq 'B::HV') {
if ($fullname !~ /::$/ or $B::C::stash) {
$pkgsym = $pkg->save($fullname);
} else {
$pkgsym = savestashpv($pkgname);
}
} else {
$pkgsym = 'NULL';
}

no strict 'refs';
warn sprintf( "xmg_stash = \"%s\" (0x%x)\n", $pkg->NAME, $$pkg )
warn sprintf( "xmg_stash = \"%s\" as %s\n", $pkgname, $pkgsym )
if $debug{mg} or $debug{gv};
# Q: Who is initializing our stash from XS? ->save is missing that.
# A: We only need to init it when we need a CV
# defer for XS loaded stashes with AMT magic
$init->add( sprintf( "SvSTASH_set(s\\_%x, (HV*)s\\_%x);", $$sv, $$pkg ) );
$init->add( sprintf( "SvREFCNT((SV*)s\\_%x) += 1;", $$pkg ) );
$init->add("++PL_sv_objcount;") unless ref($sv) eq "B::IO";
# XXX
#push_package($pkg->NAME); # correct code, but adds lots of new stashes
if (ref $pkg eq 'B::HV') {
$init->add( sprintf( "SvSTASH_set(s\\_%x, (HV*)s\\_%x);", $$sv, $$pkg ) );
$init->add( sprintf( "SvREFCNT((SV*)s\\_%x) += 1;", $$pkg ) );
$init->add("++PL_sv_objcount;") unless ref($sv) eq "B::IO";
# XXX
#push_package($pkg->NAME); # correct code, but adds lots of new stashes
}
}
}
}
Expand All @@ -3337,8 +3355,9 @@ sub B::PVMG::save_magic {
$name = $pkg->NAME if $pkg and $$pkg;
warn sprintf("initialize overload cache for %s\n", $fullname )
if $debug{mg} or $debug{gv};
$init1->add(sprintf("Gv_AMG(%s); /* init overload cache for %s */", savestashpv($name),
$fullname));
# This is destructive, it removes the magic instead of adding it.
#$init1->add(sprintf("Gv_AMG(%s); /* init overload cache for %s */", savestashpv($name),
# $fullname));
}

my @mgchain = $sv->MAGIC;
Expand Down Expand Up @@ -5213,11 +5232,11 @@ sub B::AV::save {
if ($PERL522 and $fullname =~ /^(.*)::ISA$/) {
my $name = $1;
if (0) {
my ($cname,$len,$utf8) = strlen_flags($1);
my ($cname,$len,$utf8) = strlen_flags($name);
my $gv = gv_fetchpvn($name."::", "GV_ADD|GV_NOTQUAL", "SVt_PVHV");
# This is the heavy hitter, invalidating all subpackages
$init2->add( sprintf("mro_package_moved(%s, NULL, %s, 1);",
savestash_flags($cname,$len,$utf8), $gv));
savestash_flags($name,$cname,$len,$utf8), $gv));
} else {
$init2->add( sprintf("mro_isa_changed_in(%s);", savestashpv($name)));
# $init2->add( sprintf("mro_method_changed_in(%s);", savestashpv($name)));
Expand Down Expand Up @@ -5250,6 +5269,10 @@ sub B::HV::save {
$init->add(sprintf( "HvPMROOT(hv%d) = (PMOP*)s\\_%x;",
$hv_index, $adpmroot ) );
}
if ($PERL518) {
# fix overload stringify
$init2->add( sprintf("mro_isa_changed_in(%s);", $sym));
}

# issue 79, test 46: save stashes to check for packages.
# and via B::STASHGV we only save stashes for stashes.
Expand Down
4 changes: 1 addition & 3 deletions t/testc.sh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -986,9 +986,7 @@ no warnings; $[ = 1; $big = "N\xabN\xab"; print qq{ok\n} if rindex($big, "N", 3)
tests[248]='#WONTFIX lexical $_ in re-eval
{my $s="toto";my $_="titi";{$s =~ /to(?{ print "-$_-$s-\n";})to/;}}'
result[248]='-titi-toto-'
tests[249]='#TODO version
use version; print version::is_strict(q{01}) ? 1 : 0'
result[249]='0'
tests[249]='use version; print version::is_strict(q{01}) ? 1 : q(ok)'
tests[2501]='#TODO version
use warnings qw/syntax/; use version; $withversion::VERSION = undef; eval q/package withversion 1.1_;/; print $@;'
result[2501]='Misplaced _ in number at (eval 1) line 1.
Expand Down

0 comments on commit dbfa262

Please sign in to comment.