In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/aa959a20b7e2dc9d2259242c6befcf620e6dfb5b?hp=019070c31184a4deb57cb85f7e597a789c6c5b54>
- Log ----------------------------------------------------------------- commit aa959a20b7e2dc9d2259242c6befcf620e6dfb5b Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:30:35 2012 -0700 perlvar: Correct $^Sâs description M pod/perlvar.pod commit d271dac932f48287a466118c20e43ff506047e81 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:28:21 2012 -0700 diagnostics.t: Test BEGIN{die} M lib/diagnostics.t commit 45bce001ce5dcc5df3afabba83b4ae5415f0b069 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:27:30 2012 -0700 Revert "Increase $diagnostics::VERSION to 1.31" This reverts commit c369a25dcc5e5c5b627a50d1c4b73c2be0b926b9. I have just reverted the only other change to diagnostics.pm since 5.17.2. M lib/diagnostics.pm commit ec087511b22a0ebd4a71b36d9f3bd3241226819e Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:25:50 2012 -0700 Revert "Use $^S instead of caller in splain" This reverts commit 019070c31184a4deb57cb85f7e597a789c6c5b54. I misunderstood $^S, and thought I could simplify the code. Contrary to what perlvar says, $^S is undefined not only during compilation of an eval or module, but also during compilation of the main program. M lib/diagnostics.pm commit ea9f761d76a41be44034395476e008bd0b8e2923 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:15:25 2012 -0700 perldelta for undef(&foo) and call checkers M pod/perldelta.pod commit 2f14e398cab171c93c6228512985ee84aa35be83 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:14:40 2012 -0700 Make undef &foo remove call checkers The fact that the call checker is stored in magic is an implementation detail. cv_undef does not free magic, so the call checker lives on. If we were to move the parameter prototype into magic internally, we would not want undef to stop clearing it. To me, the current situa- tion with call checkers is similar. M ext/XS-APItest/t/call_checker.t M pad.c commit 50dc2bd3d35d30eddfffb841752c40e125e49edc Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 13:01:27 2012 -0700 pad.c: document cv_forget_slab M pad.c commit baff067e717fe1c071dea706f7425994cc1d4ce9 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 22:48:27 2012 -0700 [perl #113940] Make make_ext delete Makefiles when version changes This eliminates this annoyance: $ ./perl -Ilib -MStorable -e0 Storable object version 2.37 does not match bootstrap parameter 2.38 at lib/XSLoader.pm line 95. Compilation failed in require. BEGIN failed--compilation aborted. M make_ext.pl commit d96ab1b5f316fcb0109627c2060d3b7f8a7b5016 Author: Father Chrysostomos <[email protected]> Date: Sun Jul 29 00:26:55 2012 -0700 Remove some redundant magical flag checks Now that gmagical svs use the OK flags the same way as muggles, things like SvPOK || (SvGMAGICAL && SvPOKp) are no longer necessary. M pp.c M universal.c ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/t/call_checker.t | 11 ++++++++++- lib/diagnostics.pm | 11 +++++++++-- lib/diagnostics.t | 12 +++++++++++- make_ext.pl | 22 ++++++++++++++++++++++ pad.c | 13 +++++++++++++ pod/perldelta.pod | 4 ++++ pod/perlvar.pod | 8 ++++++-- pp.c | 2 +- universal.c | 8 +++----- 9 files changed, 79 insertions(+), 12 deletions(-) diff --git a/ext/XS-APItest/t/call_checker.t b/ext/XS-APItest/t/call_checker.t index 429cea6..b01323a 100644 --- a/ext/XS-APItest/t/call_checker.t +++ b/ext/XS-APItest/t/call_checker.t @@ -1,6 +1,6 @@ use warnings; use strict; -use Test::More tests => 67; +use Test::More tests => 70; use XS::APItest; @@ -169,4 +169,13 @@ is $@, ""; is_deeply $foo_got, [ qw(a b), qw(a b c) ]; is $foo_ret, "z"; +cv_set_call_checker_lists(\&foo); +undef &foo; +$foo_got = undef; +eval 'sub foo($@) { $foo_got = [ @_ ]; return "z"; } + $foo_ret = foo(@b, @c);'; +is $@, ""; +is_deeply $foo_got, [ 2, qw(a b c) ], 'undef clears call checkers'; +is $foo_ret, "z"; + 1; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index c734c85..1efbd67 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -186,7 +186,7 @@ use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; -our $VERSION = '1.31'; +our $VERSION = '1.30'; our $DEBUG; our $VERBOSE; our $PRETTY; @@ -546,7 +546,14 @@ sub death_trap { # See if we are coming from anywhere within an eval. If so we don't # want to explain the exception because it's going to get caught. - my $in_eval = $^S || !defined $^S; + my $in_eval = 0; + my $i = 0; + while (my $caller = (caller($i++))[3]) { + if ($caller eq '(eval)') { + $in_eval = 1; + last; + } + } splainthis($exception) unless $in_eval; if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } diff --git a/lib/diagnostics.t b/lib/diagnostics.t index 035df76..b6deb20 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -4,7 +4,7 @@ BEGIN { chdir '..' if -d '../pod' && -d '../t'; @INC = 'lib'; require './t/test.pl'; - plan(19); + plan(20); } BEGIN { @@ -152,3 +152,13 @@ like runperl( main::bar\(\) called at -e line \d+ main::foo\(\) called at -e line \d+ /, 'backtrace from multiline error'; +is runperl(@runperl_args, prog => 'BEGIN { die q _panic: gremlins_ }'), + << 'EOX', 'BEGIN{die} does not suppress diagnostics'; +panic: gremlins at -e line 1. +BEGIN failed--compilation aborted at -e line 1 (#1) + (P) An internal error. + +Uncaught exception from user code: + panic: gremlins at -e line 1. + BEGIN failed--compilation aborted at -e line 1. +EOX diff --git a/make_ext.pl b/make_ext.pl index 28a67a3..3254628 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -281,6 +281,28 @@ sub build_extension { $makefile = 'Makefile'; } + if (-f $makefile) { + open my $mfh, $makefile or die "Cannot open $makefile: $!"; + while (<$mfh>) { + # Plagiarised from CPAN::Distribution + last if /MakeMaker post_initialize section/; + next unless /^#\s+VERSION_FROM\s+=>\s+(.+)/; + my $vmod = eval $1; + my $oldv; + while (<$mfh>) { + next unless /^XS_VERSION = (\S+)/; + $oldv = $1; + last; + } + last unless defined $oldv; + require ExtUtils::MM_Unix; + defined (my $newv = parse_version MM $vmod) or last; + if ($newv ne $oldv) { + 1 while unlink $makefile + } + } + } + if (!-f $makefile) { if (!-f 'Makefile.PL') { print "\nCreating Makefile.PL in $ext_dir for $mname\n"; diff --git a/pad.c b/pad.c index 0077e5b..71d5296 100644 --- a/pad.c +++ b/pad.c @@ -375,6 +375,7 @@ Perl_cv_undef(pTHX_ CV *cv) else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv); #endif SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */ + sv_unmagic((SV *)cv, PERL_MAGIC_checkcall); CvGV_set(cv, NULL); /* This statement and the subsequence if block was pad_undef(). */ @@ -486,6 +487,18 @@ Perl_cv_undef(pTHX_ CV *cv) CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON); } +/* +=for apidoc cv_forget_slab + +When a CV has a reference count on its slab (CvSLABBED), it is responsible +for making sure it is freed. (Hence, no two CVs should ever have a +reference count on the same slab.) The CV only needs to reference the slab +during compilation. Once it is compiled and CvROOT attached, it has +finished its job, so it can forget the slab. + +=cut +*/ + void Perl_cv_forget_slab(pTHX_ CV *cv) { diff --git a/pod/perldelta.pod b/pod/perldelta.pod index cbc6313..be42f56 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -398,6 +398,10 @@ having no prototype when they actually have "". Constant subroutines and forward declarations no longer prevent prototype mismatch warnings from omitting the sub name. +=item * + +C<undef> on a subroutine now clears call checkers. + =back =head1 Known Problems diff --git a/pod/perlvar.pod b/pod/perlvar.pod index da02cc6..9a6201c 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -1607,14 +1607,18 @@ X<$^S> X<$EXCEPTIONS_BEING_CAUGHT> Current state of the interpreter. $^S State - --------- ------------------- - undef Parsing module/eval + --------- ------------------------------------- + undef Parsing module, eval, or main program true (1) Executing an eval false (0) Otherwise The first state may happen in C<$SIG{__DIE__}> and C<$SIG{__WARN__}> handlers. +The English name $EXCEPTIONS_BEING_CAUGHT is slightly misleading, because +the C<undef> value does not indicate whether exceptions are being caught, +since compilation of the main program does not catch exceptions. + This variable was added in Perl 5.004. =item $WARNING diff --git a/pp.c b/pp.c index a57f609..5a40a2d 100644 --- a/pp.c +++ b/pp.c @@ -2182,7 +2182,7 @@ PP(pp_negate) { SV * const sv = TOPs; - if (SvIOK(sv) || (SvGMAGICAL(sv) && SvIOKp(sv))) { + if (SvIOK(sv)) { /* It's publicly an integer */ oops_its_an_int: if (SvIsUV(sv)) { diff --git a/universal.c b/universal.c index a7c480f..cb49e0b 100644 --- a/universal.c +++ b/universal.c @@ -198,8 +198,7 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) SvGETMAGIC(sv); - if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)) - || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) { + if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) { LEAVE; return FALSE; } @@ -334,8 +333,7 @@ XS(XS_UNIVERSAL_isa) SvGETMAGIC(sv); - if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)) - || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) + if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) XSRETURN_UNDEF; ST(0) = boolSV(sv_derived_from_sv(sv, ST(1), 0)); @@ -359,7 +357,7 @@ XS(XS_UNIVERSAL_can) SvGETMAGIC(sv); if (!SvOK(sv) || !(SvROK(sv) || SvNIOK(sv) || (SvPOK(sv) && SvCUR(sv)) - || (SvGMAGICAL(sv) && (SvNIOKp(sv) || (SvPOKp(sv) && SvCUR(sv)))))) + )) XSRETURN_UNDEF; rv = &PL_sv_undef; -- Perl5 Master Repository
