Permalink
Browse files

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).
  • Loading branch information...
1 parent 6371741 commit 0177730e7e0c099d1250571eb39367a76e2d91eb Nicholas Clark committed Jun 13, 2011
Showing with 21 additions and 14 deletions.
  1. +4 −4 ext/Devel-Peek/t/Peek.t
  2. +4 −2 mg.c
  3. +1 −0 mg_names.c
  4. +3 −1 mg_raw.h
  5. +2 −1 mg_vtable.h
  6. +2 −1 pod/perlguts.pod
  7. +1 −2 pp.c
  8. +3 −2 regen/mg_vtable.pl
  9. +1 −1 t/porting/known_pod_issues.dat
View
8 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\\)
');
}
View
6 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);
}
View
1 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)" },
View
4 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",
View
3 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 */
View
3 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
View
3 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;
}
View
5 regen/mg_vtable.pl
@@ -42,9 +42,10 @@ BEGIN
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' },
View
2 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

0 comments on commit 0177730

Please sign in to comment.