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).

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index ab30b2f..5a007af 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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