This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Store the BM table in mg_ptr instead of after SvCUR().
[perl5.git] / ext / Devel-Peek / t / Peek.t
index 3f3e9c0..c0cfa93 100644 (file)
@@ -48,7 +48,7 @@ sub do_test {
            # things like $IVNV gave the illusion that the string passed in was
            # a regexp into which variables were interpolated, but this wasn't
            # actually true as those 'variables' actually also ate the
            # things like $IVNV gave the illusion that the string passed in was
            # a regexp into which variables were interpolated, but this wasn't
            # actually true as those 'variables' actually also ate the
-           # whitspace on the line. So it seems better to mark lines that
+           # whitespace on the line. So it seems better to mark lines that
            # need to be eliminated. I considered (?# ... ) and (?{ ... }),
            # but whilst embedded code or comment syntax would keep it as a
            # legitimate regexp, it still isn't true. Seems easier and clearer
            # need to be eliminated. I considered (?# ... ) and (?{ ... }),
            # but whilst embedded code or comment syntax would keep it as a
            # legitimate regexp, it still isn't true. Seems easier and clearer
@@ -122,7 +122,7 @@ do_test('immediate constant (string)',
   CUR = 3
   LEN = \\d+');
 
   CUR = 3
   LEN = \\d+');
 
-do_test('assigment of immediate constant (integer)',
+do_test('assignment of immediate constant (integer)',
         $b = 123,
 'SV = IV\\($ADDR\\) at $ADDR
   REFCNT = 1
         $b = 123,
 'SV = IV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -332,7 +332,28 @@ do_test('reference to regexp',
     PV = $ADDR "\\(\\?\\^:tic\\)"
     CUR = 8
     LEN = 0
     PV = $ADDR "\\(\\?\\^:tic\\)"
     CUR = 8
     LEN = 0
-    STASH = $ADDR\\t"Regexp"');
+    STASH = $ADDR\\t"Regexp"'
+. ($] < 5.013 ? '' :
+'
+    EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
+    INTFLAGS = 0x0
+    NPARENS = 0
+    LASTPAREN = 0
+    LASTCLOSEPAREN = 0
+    MINLEN = 3
+    MINLENRET = 3
+    GOFS = 0
+    PRE_PREFIX = 4
+    SEEN_EVALS = 0
+    SUBLEN = 0
+    SUBBEG = 0x0
+    ENGINE = $ADDR
+    MOTHER_RE = $ADDR
+    PAREN_NAMES = 0x0
+    SUBSTRS = $ADDR
+    PPRIVATE = $ADDR
+    OFFS = $ADDR'
+));
 } else {
 do_test('reference to regexp',
         qr(tic),
 } else {
 do_test('reference to regexp',
         qr(tic),
@@ -660,7 +681,7 @@ do_test('FORMAT',
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
 
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
 
-do_test('blessing to a class with embeded NUL characters',
+do_test('blessing to a class with embedded NUL characters',
         (bless {}, "\0::foo::\n::baz::\t::\0"),
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
         (bless {}, "\0::foo::\n::baz::\t::\0"),
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -681,4 +702,186 @@ do_test('blessing to a class with embeded NUL characters',
        $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
        : "Something causes the HV's array to become allocated");
 
        $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
        : "Something causes the HV's array to become allocated");
 
+do_test('ENAME on a stash',
+        \%RWOM::,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(OOK,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    NAME = "RWOM"
+    ENAME = "RWOM"                             # $] > 5.012
+');
+
+*KLANK:: = \%RWOM::;
+
+do_test('ENAMEs on a stash',
+        \%RWOM::,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 3
+    FLAGS = \\(OOK,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    NAME = "RWOM"
+    NAMECOUNT = 2                              # $] > 5.012
+    ENAME = "RWOM", "KLANK"                    # $] > 5.012
+');
+
+undef %RWOM::;
+
+do_test('ENAMEs on a stash with no NAME',
+        \%RWOM::,
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 3
+    FLAGS = \\(OOK,SHAREKEYS\\)
+    IV = 1                                     # $] < 5.009
+    NV = $FLOAT                                        # $] < 5.009
+    ARRAY = $ADDR
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    NAMECOUNT = -3                             # $] > 5.012
+    ENAME = "RWOM", "KLANK"                    # $] > 5.012
+');
+
+SKIP: {
+    skip "Not built with usemymalloc", 1
+      unless $Config{usemymalloc} eq 'y';
+    my $x = __PACKAGE__;
+    ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
+     or diag $@;
+}
+
+# This is more a test of fbm_compile/pp_study (non) interaction than dumping
+# prowess, but short of duplicating all the gubbins of this file, I can't see
+# a way to make a better place for it:
+
+use constant {
+    perl => 'rules',
+    beer => 'foamy',
+};
+
+unless ($Config{useithreads}) {
+    # These end up as copies in pads under ithreads, which rather defeats the
+    # the point of what we're trying to test here.
+
+    do_test('regular string constant', perl,
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
+  PV = $ADDR "rules"\\\0
+  CUR = 5
+  LEN = \d+
+');
+
+    eval 'index "", perl';
+
+    # FIXME - really this shouldn't say EVALED. It's a false posistive on
+    # 0x40000000 being used for several things, not a flag for "I'm in a string
+    # eval"
+
+    do_test('string constant now an FBM', perl,
+'SV = PVGV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
+  PV = $ADDR "rules"\\\0
+  CUR = 5
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_bm
+    MG_TYPE = PERL_MAGIC_bm\\(B\\)
+    MG_LEN = 256
+    MG_PTR = $ADDR "(?:\\\\\d){256}"
+  RARE = \d+
+  PREVIOUS = 1
+  USEFUL = 100
+');
+
+    is(study perl, '', "Not allowed to study an FBM");
+
+    do_test('string constant still an FBM', perl,
+'SV = PVGV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
+  PV = $ADDR "rules"\\\0
+  CUR = 5
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_bm
+    MG_TYPE = PERL_MAGIC_bm\\(B\\)
+    MG_LEN = 256
+    MG_PTR = $ADDR "(?:\\\\\d){256}"
+  RARE = \d+
+  PREVIOUS = 1
+  USEFUL = 100
+');
+
+    do_test('regular string constant', beer,
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
+  PV = $ADDR "foamy"\\\0
+  CUR = 5
+  LEN = \d+
+');
+
+    is(study beer, 1, "Our studies were successful");
+
+    do_test('string constant now studied', beer,
+'SV = PVMG\\($ADDR\\) at $ADDR
+  REFCNT = 6
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,SCREAM\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR "foamy"\\\0
+  CUR = 5
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_mglob
+    MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
+');
+
+    is (eval 'index "not too foamy", beer', 8, 'correct index');
+
+    do_test('string constant still studied', beer,
+'SV = PVMG\\($ADDR\\) at $ADDR
+  REFCNT = 6
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,SCREAM\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR "foamy"\\\0
+  CUR = 5
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_mglob
+    MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
+');
+}
+
 done_testing();
 done_testing();