Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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...
commit 0177730e7e0c099d1250571eb39367a76e2d91eb 1 parent 6371741
authored June 13, 2011
8  ext/Devel-Peek/t/Peek.t
@@ -876,8 +876,8 @@ unless ($Config{useithreads}) {
876 876
   CUR = 5
877 877
   LEN = \d+
878 878
   MAGIC = $ADDR
879  
-    MG_VIRTUAL = &PL_vtbl_mglob
880  
-    MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
  879
+    MG_VIRTUAL = &PL_vtbl_regexp
  880
+    MG_TYPE = PERL_MAGIC_study\\(G\\)
881 881
 ');
882 882
 
883 883
     is (eval 'index "not too foamy", beer', 8, 'correct index');
@@ -892,8 +892,8 @@ unless ($Config{useithreads}) {
892 892
   CUR = 5
893 893
   LEN = \d+
894 894
   MAGIC = $ADDR
895  
-    MG_VIRTUAL = &PL_vtbl_mglob
896  
-    MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
  895
+    MG_VIRTUAL = &PL_vtbl_regexp
  896
+    MG_TYPE = PERL_MAGIC_study\\(G\\)
897 897
 ');
898 898
 }
899 899
 
6  mg.c
@@ -2358,9 +2358,8 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
2358 2358
 {
2359 2359
     PERL_ARGS_ASSERT_MAGIC_SETMGLOB;
2360 2360
     PERL_UNUSED_CONTEXT;
  2361
+    PERL_UNUSED_ARG(sv);
2361 2362
     mg->mg_len = -1;
2362  
-    if (!isGV_with_GP(sv))
2363  
-	SvSCREAM_off(sv);
2364 2363
     return 0;
2365 2364
 }
2366 2365
 
@@ -2387,6 +2386,9 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
2387 2386
     } else if (type == PERL_MAGIC_bm) {
2388 2387
 	SvTAIL_off(sv);
2389 2388
 	SvVALID_off(sv);
  2389
+    } else if (type == PERL_MAGIC_study) {
  2390
+	if (!isGV_with_GP(sv))
  2391
+	    SvSCREAM_off(sv);
2390 2392
     } else {
2391 2393
 	assert(type == PERL_MAGIC_fm);
2392 2394
     }
1  mg_names.c
@@ -22,6 +22,7 @@
22 22
 	{ PERL_MAGIC_env,            "env(E)" },
23 23
 	{ PERL_MAGIC_envelem,        "envelem(e)" },
24 24
 	{ PERL_MAGIC_fm,             "fm(f)" },
  25
+	{ PERL_MAGIC_study,          "study(G)" },
25 26
 	{ PERL_MAGIC_regex_global,   "regex_global(g)" },
26 27
 	{ PERL_MAGIC_hints,          "hints(H)" },
27 28
 	{ PERL_MAGIC_hintselem,      "hintselem(h)" },
4  mg_raw.h
@@ -38,8 +38,10 @@
38 38
       "/* envelem 'e' %ENV hash element */" },
39 39
     { 'f', "want_vtbl_regdata | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC",
40 40
       "/* fm 'f' Formline ('compiled' format) */" },
  41
+    { 'G', "want_vtbl_regexp | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC",
  42
+      "/* study 'G' study()ed string */" },
41 43
     { 'g', "want_vtbl_mglob | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC",
42  
-      "/* regex_global 'g' m//g target / study()ed string */" },
  44
+      "/* regex_global 'g' m//g target */" },
43 45
     { 'H', "want_vtbl_hints",
44 46
       "/* hints 'H' %^H hash */" },
45 47
     { 'h', "want_vtbl_hintselem",
3  mg_vtable.h
@@ -29,7 +29,8 @@
29 29
 #define PERL_MAGIC_env            'E' /* %ENV hash */
30 30
 #define PERL_MAGIC_envelem        'e' /* %ENV hash element */
31 31
 #define PERL_MAGIC_fm             'f' /* Formline ('compiled' format) */
32  
-#define PERL_MAGIC_regex_global   'g' /* m//g target / study()ed string */
  32
+#define PERL_MAGIC_study          'G' /* study()ed string */
  33
+#define PERL_MAGIC_regex_global   'g' /* m//g target */
33 34
 #define PERL_MAGIC_hints          'H' /* %^H hash */
34 35
 #define PERL_MAGIC_hintselem      'h' /* %^H hash element */
35 36
 #define PERL_MAGIC_isa            'I' /* @ISA array */
3  pod/perlguts.pod
Source Rendered
@@ -1055,7 +1055,8 @@ The current kinds of Magic Virtual Tables are:
1055 1055
     E  PERL_MAGIC_env            vtbl_env        %ENV hash
1056 1056
     e  PERL_MAGIC_envelem        vtbl_envelem    %ENV hash element
1057 1057
     f  PERL_MAGIC_fm             vtbl_regdata    Formline ('compiled' format)
1058  
-    g  PERL_MAGIC_regex_global   vtbl_mglob      m//g target / study()ed string
  1058
+    G  PERL_MAGIC_study          vtbl_regdata    study()ed string
  1059
+    g  PERL_MAGIC_regex_global   vtbl_mglob      m//g target
1059 1060
     H  PERL_MAGIC_hints          vtbl_hints      %^H hash
1060 1061
     h  PERL_MAGIC_hintselem      vtbl_hintselem  %^H hash element
1061 1062
     I  PERL_MAGIC_isa            vtbl_isa        @ISA array
3  pp.c
@@ -769,8 +769,7 @@ PP(pp_study)
769 769
     }
770 770
 
771 771
     SvSCREAM_on(sv);
772  
-    /* piggyback on m//g magic */
773  
-    sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0);
  772
+    sv_magic(sv, NULL, PERL_MAGIC_study, NULL, 0);
774 773
     RETPUSHYES;
775 774
 }
776 775
 
5  regen/mg_vtable.pl
@@ -42,9 +42,10 @@ BEGIN
42 42
 		  desc => '%ENV hash element' },
43 43
      fm => { char => 'f', vtable => 'regdata', value_magic => 1,
44 44
 	     readonly_acceptable => 1, desc => "Formline ('compiled' format)" },
  45
+     study => { char => 'G', vtable => 'regexp', value_magic => 1,
  46
+		readonly_acceptable => 1, desc => 'study()ed string' },
45 47
      regex_global => { char => 'g', vtable => 'mglob', value_magic => 1,
46  
-		       readonly_acceptable => 1,
47  
-		       desc => 'm//g target / study()ed string' },
  48
+		       readonly_acceptable => 1, desc => 'm//g target' },
48 49
      hints => { char => 'H', vtable => 'hints', desc => '%^H hash' },
49 50
      hintselem => { char => 'h', vtable => 'hintselem',
50 51
 		    desc => '%^H hash element' },
2  t/porting/known_pod_issues.dat
@@ -233,7 +233,7 @@ pod/perlgit.pod	Verbatim line length including indents exceeds 80 by	14
233 233
 pod/perlgpl.pod	Verbatim line length including indents exceeds 80 by	50
234 234
 pod/perlguts.pod	? Should you be using F<...> or maybe L<...> instead of	2
235 235
 pod/perlguts.pod	? Should you be using L<...> instead of	1
236  
-pod/perlguts.pod	Verbatim line length including indents exceeds 80 by	26
  236
+pod/perlguts.pod	Verbatim line length including indents exceeds 80 by	25
237 237
 pod/perlhack.pod	? Should you be using L<...> instead of	1
238 238
 pod/perlhack.pod	Verbatim line length including indents exceeds 80 by	1
239 239
 pod/perlhacktips.pod	Verbatim line length including indents exceeds 80 by	1

0 notes on commit 0177730

Please sign in to comment.
Something went wrong with that request. Please try again.