diff --git a/embed.fnc b/embed.fnc index 551d46880562..cad6716c7c29 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1330,6 +1330,7 @@ p |int |magic_setnkeys |NN SV* sv|NN MAGIC* mg p |int |magic_setpack |NN SV* sv|NN MAGIC* mg p |int |magic_setpos |NN SV* sv|NN MAGIC* mg p |int |magic_setregexp|NN SV* sv|NN MAGIC* mg +p |int |magic_setsigall|NN SV* sv|NN MAGIC* mg p |int |magic_setsig |NULLOK SV* sv|NN MAGIC* mg p |int |magic_setsubstr|NN SV* sv|NN MAGIC* mg p |int |magic_settaint |NN SV* sv|NN MAGIC* mg diff --git a/embed.h b/embed.h index 10214db1fb08..4fc037db1eba 100644 --- a/embed.h +++ b/embed.h @@ -1386,6 +1386,7 @@ #define magic_setpos(a,b) Perl_magic_setpos(aTHX_ a,b) #define magic_setregexp(a,b) Perl_magic_setregexp(aTHX_ a,b) #define magic_setsig(a,b) Perl_magic_setsig(aTHX_ a,b) +#define magic_setsigall(a,b) Perl_magic_setsigall(aTHX_ a,b) #define magic_setsubstr(a,b) Perl_magic_setsubstr(aTHX_ a,b) #define magic_settaint(a,b) Perl_magic_settaint(aTHX_ a,b) #define magic_setutf8(a,b) Perl_magic_setutf8(aTHX_ a,b) diff --git a/hv.c b/hv.c index f503dae14c69..bc2f24c177e2 100644 --- a/hv.c +++ b/hv.c @@ -1123,7 +1123,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, GV *gv = NULL; HV *stash = NULL; - if (SvRMAGICAL(hv)) { + if (SvMAGICAL(hv)) { bool needs_copy; bool needs_store; hv_magic_check (hv, &needs_copy, &needs_store); diff --git a/mg.c b/mg.c index 3355df1b4b64..bd71ce15b7ad 100644 --- a/mg.c +++ b/mg.c @@ -1826,6 +1826,24 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) } #endif /* !PERL_MICRO */ +int +Perl_magic_setsigall(pTHX_ SV* sv, MAGIC* mg) +{ + PERL_ARGS_ASSERT_MAGIC_SETSIGALL; + PERL_UNUSED_ARG(mg); + + if (PL_localizing == 2) { + HV* hv = (HV*)sv; + HE* current; + hv_iterinit(hv); + while ((current = hv_iternext(hv))) { + SV* sigelem = hv_iterval(hv, current); + mg_set(sigelem); + } + } + return 0; +} + int Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) { diff --git a/mg_raw.h b/mg_raw.h index 2f4863b08e97..c55e64372ccf 100644 --- a/mg_raw.h +++ b/mg_raw.h @@ -62,7 +62,7 @@ "/* tiedscalar 'q' Tied scalar or handle */" }, { 'r', "want_vtbl_regexp | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", "/* qr 'r' Precompiled qr// regex */" }, - { 'S', "magic_vtable_max", + { 'S', "want_vtbl_sig", "/* sig 'S' %SIG hash */" }, { 's', "want_vtbl_sigelem", "/* sigelem 's' %SIG hash element */" }, diff --git a/mg_vtable.h b/mg_vtable.h index e5c8cba37c90..8f59573ca11b 100644 --- a/mg_vtable.h +++ b/mg_vtable.h @@ -85,6 +85,7 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_regdata, want_vtbl_regdatum, want_vtbl_regexp, + want_vtbl_sig, want_vtbl_sigelem, want_vtbl_substr, want_vtbl_sv, @@ -122,6 +123,7 @@ EXTCONST char * const PL_magic_vtable_names[magic_vtable_max] = { "regdata", "regdatum", "regexp", + "sig", "sigelem", "substr", "sv", @@ -182,6 +184,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = { { 0, 0, Perl_magic_regdata_cnt, 0, 0, 0, 0, 0 }, { Perl_magic_regdatum_get, Perl_magic_regdatum_set, 0, 0, 0, 0, 0, 0 }, { 0, Perl_magic_setregexp, 0, 0, 0, 0, 0, 0 }, + { 0, Perl_magic_setsigall, 0, 0, 0, 0, 0, 0 }, #ifndef PERL_MICRO { Perl_magic_getsig, Perl_magic_setsig, 0, Perl_magic_clearsig, 0, 0, 0, 0 }, #else @@ -228,6 +231,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max]; #define PL_vtbl_regdata PL_magic_vtables[want_vtbl_regdata] #define PL_vtbl_regdatum PL_magic_vtables[want_vtbl_regdatum] #define PL_vtbl_regexp PL_magic_vtables[want_vtbl_regexp] +#define PL_vtbl_sig PL_magic_vtables[want_vtbl_sig] #define PL_vtbl_sigelem PL_magic_vtables[want_vtbl_sigelem] #define PL_vtbl_substr PL_magic_vtables[want_vtbl_substr] #define PL_vtbl_sv PL_magic_vtables[want_vtbl_sv] diff --git a/pod/perlguts.pod b/pod/perlguts.pod index f1fd7da34af7..fc848bce6c76 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1415,7 +1415,7 @@ will be lost. p PERL_MAGIC_tiedelem vtbl_packelem Tied array or hash element q PERL_MAGIC_tiedscalar vtbl_packelem Tied scalar or handle r PERL_MAGIC_qr vtbl_regexp Precompiled qr// regex - S PERL_MAGIC_sig (none) %SIG hash + S PERL_MAGIC_sig vtbl_sig %SIG hash s PERL_MAGIC_sigelem vtbl_sigelem %SIG hash element t PERL_MAGIC_taint vtbl_taint Taintedness U PERL_MAGIC_uvar vtbl_uvar Available for use by diff --git a/proto.h b/proto.h index faca6d1366e1..d868461e6039 100644 --- a/proto.h +++ b/proto.h @@ -1994,6 +1994,9 @@ PERL_CALLCONV int Perl_magic_setregexp(pTHX_ SV* sv, MAGIC* mg); PERL_CALLCONV int Perl_magic_setsig(pTHX_ SV* sv, MAGIC* mg); #define PERL_ARGS_ASSERT_MAGIC_SETSIG \ assert(mg) +PERL_CALLCONV int Perl_magic_setsigall(pTHX_ SV* sv, MAGIC* mg); +#define PERL_ARGS_ASSERT_MAGIC_SETSIGALL \ + assert(sv); assert(mg) PERL_CALLCONV int Perl_magic_setsubstr(pTHX_ SV* sv, MAGIC* mg); #define PERL_ARGS_ASSERT_MAGIC_SETSUBSTR \ assert(sv); assert(mg) diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index ebd34130825f..0dd27301b576 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -168,7 +168,8 @@ BEGIN desc => 'Tied scalar or handle' }, qr => { char => 'r', vtable => 'regexp', value_magic => 1, readonly_acceptable => 1, desc => 'Precompiled qr// regex' }, - sig => { char => 'S', desc => '%SIG hash' }, + sig => { char => 'S', vtable => 'sig', + desc => '%SIG hash' }, sigelem => { char => 's', vtable => 'sigelem', desc => '%SIG hash element' }, taint => { char => 't', vtable => 'taint', value_magic => 1, @@ -251,6 +252,7 @@ BEGIN 'sv' => {get => 'get', set => 'set'}, 'env' => {set => 'set_all_env', clear => 'clear_all_env'}, 'envelem' => {set => 'setenv', clear => 'clearenv'}, + 'sig' => { set => 'setsigall' }, 'sigelem' => {get => 'getsig', set => 'setsig', clear => 'clearsig', cond => '#ifndef PERL_MICRO'}, 'pack' => {len => 'sizepack', clear => 'wipepack'}, diff --git a/t/op/magic.t b/t/op/magic.t index c2180afb9d82..0d8e32a543fd 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc( '../lib' ); - plan (tests => 196); # some tests are run in BEGIN block + plan (tests => 197); # some tests are run in BEGIN block } # Test that defined() returns true for magic variables created on the fly, @@ -852,6 +852,11 @@ SKIP: { } } +{ + local %SIG = (%SIG, ALRM => sub {}) +}; +is $SIG{ALRM}, undef; + # test case-insignificance of %ENV (these tests must be enabled only # when perl is compiled with -DENV_IS_CASELESS) SKIP: {