From 0177730e7e0c099d1250571eb39367a76e2d91eb Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Mon, 13 Jun 2011 16:24:23 +0200 Subject: [PATCH] Split out study magic from pos magic. study uses magic to call SvSCREAM_off() if the scalar is modified. Allocate it its own magic type ('G' for now - pos magic is 'g'). Share the same "set" routine and vtable as regexp/bm/fm (setregxp and vtbl_regexp). --- ext/Devel-Peek/t/Peek.t | 8 ++++---- mg.c | 6 ++++-- mg_names.c | 1 + mg_raw.h | 4 +++- mg_vtable.h | 3 ++- pod/perlguts.pod | 3 ++- pp.c | 3 +-- regen/mg_vtable.pl | 5 +++-- t/porting/known_pod_issues.dat | 2 +- 9 files changed, 21 insertions(+), 14 deletions(-) diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index ab30b2f..5a007af 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -876,8 +876,8 @@ unless ($Config{useithreads}) { CUR = 5 LEN = \d+ MAGIC = $ADDR - MG_VIRTUAL = &PL_vtbl_mglob - MG_TYPE = PERL_MAGIC_regex_global\\(g\\) + MG_VIRTUAL = &PL_vtbl_regexp + MG_TYPE = PERL_MAGIC_study\\(G\\) '); is (eval 'index "not too foamy", beer', 8, 'correct index'); @@ -892,8 +892,8 @@ unless ($Config{useithreads}) { CUR = 5 LEN = \d+ MAGIC = $ADDR - MG_VIRTUAL = &PL_vtbl_mglob - MG_TYPE = PERL_MAGIC_regex_global\\(g\\) + MG_VIRTUAL = &PL_vtbl_regexp + MG_TYPE = PERL_MAGIC_study\\(G\\) '); } diff --git a/mg.c b/mg.c index 1bdf5c4..9e18918 100644 --- a/mg.c +++ b/mg.c @@ -2358,9 +2358,8 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg) { PERL_ARGS_ASSERT_MAGIC_SETMGLOB; PERL_UNUSED_CONTEXT; + PERL_UNUSED_ARG(sv); mg->mg_len = -1; - if (!isGV_with_GP(sv)) - SvSCREAM_off(sv); return 0; } @@ -2387,6 +2386,9 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) } else if (type == PERL_MAGIC_bm) { SvTAIL_off(sv); SvVALID_off(sv); + } else if (type == PERL_MAGIC_study) { + if (!isGV_with_GP(sv)) + SvSCREAM_off(sv); } else { assert(type == PERL_MAGIC_fm); } diff --git a/mg_names.c b/mg_names.c index ff73b9e..43b1945 100644 --- a/mg_names.c +++ b/mg_names.c @@ -22,6 +22,7 @@ { PERL_MAGIC_env, "env(E)" }, { PERL_MAGIC_envelem, "envelem(e)" }, { PERL_MAGIC_fm, "fm(f)" }, + { PERL_MAGIC_study, "study(G)" }, { PERL_MAGIC_regex_global, "regex_global(g)" }, { PERL_MAGIC_hints, "hints(H)" }, { PERL_MAGIC_hintselem, "hintselem(h)" }, diff --git a/mg_raw.h b/mg_raw.h index e698dcd..7a45e6d 100644 --- a/mg_raw.h +++ b/mg_raw.h @@ -38,8 +38,10 @@ "/* envelem 'e' %ENV hash element */" }, { 'f', "want_vtbl_regdata | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", "/* fm 'f' Formline ('compiled' format) */" }, + { 'G', "want_vtbl_regexp | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", + "/* study 'G' study()ed string */" }, { 'g', "want_vtbl_mglob | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", - "/* regex_global 'g' m//g target / study()ed string */" }, + "/* regex_global 'g' m//g target */" }, { 'H', "want_vtbl_hints", "/* hints 'H' %^H hash */" }, { 'h', "want_vtbl_hintselem", diff --git a/mg_vtable.h b/mg_vtable.h index 8846262..2e3ca35 100644 --- a/mg_vtable.h +++ b/mg_vtable.h @@ -29,7 +29,8 @@ #define PERL_MAGIC_env 'E' /* %ENV hash */ #define PERL_MAGIC_envelem 'e' /* %ENV hash element */ #define PERL_MAGIC_fm 'f' /* Formline ('compiled' format) */ -#define PERL_MAGIC_regex_global 'g' /* m//g target / study()ed string */ +#define PERL_MAGIC_study 'G' /* study()ed string */ +#define PERL_MAGIC_regex_global 'g' /* m//g target */ #define PERL_MAGIC_hints 'H' /* %^H hash */ #define PERL_MAGIC_hintselem 'h' /* %^H hash element */ #define PERL_MAGIC_isa 'I' /* @ISA array */ diff --git a/pod/perlguts.pod b/pod/perlguts.pod index e99c051..d8f0527 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1055,7 +1055,8 @@ The current kinds of Magic Virtual Tables are: E PERL_MAGIC_env vtbl_env %ENV hash e PERL_MAGIC_envelem vtbl_envelem %ENV hash element f PERL_MAGIC_fm vtbl_regdata Formline ('compiled' format) - g PERL_MAGIC_regex_global vtbl_mglob m//g target / study()ed string + G PERL_MAGIC_study vtbl_regdata study()ed string + g PERL_MAGIC_regex_global vtbl_mglob m//g target H PERL_MAGIC_hints vtbl_hints %^H hash h PERL_MAGIC_hintselem vtbl_hintselem %^H hash element I PERL_MAGIC_isa vtbl_isa @ISA array diff --git a/pp.c b/pp.c index 24a34a0..c72ce28 100644 --- a/pp.c +++ b/pp.c @@ -769,8 +769,7 @@ PP(pp_study) } SvSCREAM_on(sv); - /* piggyback on m//g magic */ - sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0); + sv_magic(sv, NULL, PERL_MAGIC_study, NULL, 0); RETPUSHYES; } diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index af0041d..799be6b 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -42,9 +42,10 @@ my %mg = desc => '%ENV hash element' }, fm => { char => 'f', vtable => 'regdata', value_magic => 1, readonly_acceptable => 1, desc => "Formline ('compiled' format)" }, + study => { char => 'G', vtable => 'regexp', value_magic => 1, + readonly_acceptable => 1, desc => 'study()ed string' }, regex_global => { char => 'g', vtable => 'mglob', value_magic => 1, - readonly_acceptable => 1, - desc => 'm//g target / study()ed string' }, + readonly_acceptable => 1, desc => 'm//g target' }, hints => { char => 'H', vtable => 'hints', desc => '%^H hash' }, hintselem => { char => 'h', vtable => 'hintselem', desc => '%^H hash element' }, diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 1a0d0f1..e17a573 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -233,7 +233,7 @@ pod/perlgit.pod Verbatim line length including indents exceeds 80 by 14 pod/perlgpl.pod Verbatim line length including indents exceeds 80 by 50 pod/perlguts.pod ? Should you be using F<...> or maybe L<...> instead of 2 pod/perlguts.pod ? Should you be using L<...> instead of 1 -pod/perlguts.pod Verbatim line length including indents exceeds 80 by 26 +pod/perlguts.pod Verbatim line length including indents exceeds 80 by 25 pod/perlhack.pod ? Should you be using L<...> instead of 1 pod/perlhack.pod Verbatim line length including indents exceeds 80 by 1 pod/perlhacktips.pod Verbatim line length including indents exceeds 80 by 1 -- 2.7.4