From: Nicholas Clark Date: Sun, 3 Feb 2008 13:37:06 +0000 (+0000) Subject: Produce a more generic expectation management system, and use it to X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=000fd473bcb6f2819bac7f3c521cf6bb9214a49f;p=p5sagit%2Fp5-mst-13.2.git Produce a more generic expectation management system, and use it to encode the 5.8.x vs 5.10/5.11 differences. Provide general purpose TODOs for both the intial tests and Gerard's "is it unchanged on repeat?" test. p4raw-id: //depot/perl@33223 --- diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 0ef8a4b..755af83 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -20,7 +20,9 @@ our $DEBUG = 0; open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!"; sub do_test { - my $pattern = pop; + my $todo = $_[3]; + my $repeat_todo = $_[4]; + my $pattern = $_[2]; if (open(OUT,">peek$$")) { open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; Dump($_[1]); @@ -35,6 +37,31 @@ sub do_test { # handle DEBUG_LEAKING_SCALARS prefix $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg; + # Need some clear generic mechanism to eliminate (or add) lines + # of dump output dependant on perl version. The (previous) use of + # 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 + # 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 + # things that look like comments. + + # Could do this is in a s///mge but seems clearer like this: + $pattern = join '', map { + # If we identify the version condition, take *it* out whatever + s/\s*# (\$] [<>]=? 5\.\d\d\d)$// + ? (eval $1 ? $_ : '') + : $_ # Didn't match, so this line is in + } split /^/, $pattern; + + $pattern =~ s/\$PADMY/ + ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY'; + /mge; + $pattern =~ s/\$PADTMP/ + ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP'; + /mge; $pattern =~ s/^ *\$XSUB *\n/ ($] < 5.009) ? " XSUB = 0x0\n XSUBANY = 0\n" : ''; /mge; @@ -60,7 +87,7 @@ sub do_test { print $dump, "\n" if $DEBUG; like( $dump, qr/\A$pattern\Z/ms ); - local $TODO = $dump2 =~ /OOK/ ? "The hash iterator used in dump.c sets the OOK flag" : undef; + local $TODO = $repeat_todo; is($dump2, $dump); close(IN); @@ -120,7 +147,7 @@ do_test( 5, $c = 456, 'SV = IV\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\(PADMY,IOK,pIOK\\) + FLAGS = \\($PADMY,IOK,pIOK\\) IV = 456'); # If perl is built with PERL_PRESERVE_IVUV then maths is done as integers @@ -199,6 +226,8 @@ do_test(11, SV = PVAV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(\\) + IV = 0 # $] < 5.009 + NV = 0 # $] < 5.009 ARRAY = $ADDR FILL = 1 MAX = 1 @@ -220,6 +249,8 @@ do_test(12, SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(SHAREKEYS\\) + IV = 1 # $] < 5.009 + NV = $FLOAT # $] < 5.009 ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% KEYS = 1 @@ -227,7 +258,9 @@ do_test(12, MAX = 7 RITER = -1 EITER = 0x0 - Elt "123" HASH = $ADDR' . $c_pattern); + Elt "123" HASH = $ADDR' . $c_pattern, + '', + $] > 5.009 && 'The hash iterator used in dump.c sets the OOK flag'); do_test(13, sub(){@_}, @@ -237,7 +270,7 @@ do_test(13, RV = $ADDR SV = PVCV\\($ADDR\\) at $ADDR REFCNT = 2 - FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\) + FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\) $IVNV PROTOTYPE = "" COMP_STASH = $ADDR\\t"main" @@ -246,10 +279,11 @@ do_test(13, $XSUB GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*" FILE = ".*\\b(?i:peek\\.t)" - DEPTH = 0 -(?: MUTEXP = $ADDR - OWNER = $ADDR -)? FLAGS = 0x90 + DEPTH = 0(?: + MUTEXP = $ADDR + OWNER = $ADDR)? + FLAGS = 0x404 # $] < 5.009 + FLAGS = 0x90 # $] >= 5.009 OUTSIDE_SEQ = \\d+ PADLIST = $ADDR PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) @@ -278,8 +312,11 @@ do_test(14, OUTSIDE_SEQ = \\d+ PADLIST = $ADDR PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) + \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo" + \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo" \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern" - \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 + \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009 + \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump" \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2" OUTSIDE = $ADDR \\(MAIN\\)'); @@ -316,8 +353,8 @@ do_test(15, MG_VIRTUAL = $ADDR MG_TYPE = PERL_MAGIC_qr\(r\) MG_OBJ = $ADDR - PAT = "\(\?-xism:tic\)" - REFCNT = 2 + PAT = "\(\?-xism:tic\)" # $] >= 5.009 + REFCNT = 2 # $] >= 5.009 STASH = $ADDR\\t"Regexp"'); } @@ -330,19 +367,31 @@ do_test(16, SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(OBJECT,SHAREKEYS\\) + IV = 0 # $] < 5.009 + NV = 0 # $] < 5.009 STASH = $ADDR\\t"Tac" ARRAY = 0x0 KEYS = 0 FILL = 0 MAX = 7 RITER = -1 - EITER = 0x0'); + EITER = 0x0', '', + $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' + : "Something causes the HV's array to become allocated"); do_test(17, *a, 'SV = PVGV\\($ADDR\\) at $ADDR REFCNT = 5 - FLAGS = \\(MULTI(?:,IN_PAD)?\\) + FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009 + FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009 + IV = 0 # $] < 5.009 + NV = 0 # $] < 5.009 + PV = 0 # $] < 5.009 + MAGIC = $ADDR # $] < 5.009 + MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009 + MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009 + MG_OBJ = $ADDR # $] < 5.009 NAME = "a" NAMELEN = 1 GvSTASH = $ADDR\\t"main" @@ -355,6 +404,7 @@ do_test(17, HV = 0x0 CV = 0x0 CVGEN = 0x0 + GPFLAGS = 0x0 # $] < 5.009 LINE = \\d+ FILE = ".*\\b(?i:peek\\.t)" FLAGS = $ADDR @@ -365,7 +415,7 @@ do_test(18, chr(256).chr(0).chr(512), 'SV = PV\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\) + FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] CUR = 5 LEN = \\d+'); @@ -374,7 +424,7 @@ do_test(18, chr(256).chr(0).chr(512), 'SV = PV\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\) + FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] CUR = 5 LEN = \\d+'); @@ -390,6 +440,8 @@ do_test(19, SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(SHAREKEYS,HASKFLAGS\\) + UV = 1 # $] < 5.009 + NV = $FLOAT # $] < 5.009 ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% KEYS = 1 @@ -403,7 +455,9 @@ do_test(19, FLAGS = \\(POK,pPOK,UTF8\\) PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\] CUR = 2 - LEN = \\d+'); + LEN = \\d+', + $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' + : 'sv_length has been called on the element, and cached the result in MAGIC'); } else { do_test(19, {chr(256)=>chr(512)}, @@ -414,6 +468,8 @@ do_test(19, SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(SHAREKEYS,HASKFLAGS\\) + UV = 1 # $] < 5.009 + NV = 0 # $] < 5.009 ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% KEYS = 1 @@ -427,7 +483,9 @@ do_test(19, FLAGS = \\(POK,pPOK,UTF8\\) PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\] CUR = 2 - LEN = \\d+'); + LEN = \\d+', '', + $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' + : 'sv_length has been called on the element, and cached the result in MAGIC'); } my $x=""; @@ -436,7 +494,7 @@ do_test(20, $x, 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\(PADMY,SMG,POK,pPOK\\) + FLAGS = \\($PADMY,SMG,POK,pPOK\\) IV = 0 NV = 0 PV = $ADDR ""\\\0 @@ -533,10 +591,11 @@ do_test(23, LEN = \\d+ GVGV::GV = $ADDR\\t"main" :: "const" FILE = ".*\\b(?i:peek\\.t)" - DEPTH = 0 -(?: MUTEXP = $ADDR - OWNER = $ADDR -)? FLAGS = 0xc00 + DEPTH = 0(?: + MUTEXP = $ADDR + OWNER = $ADDR)? + FLAGS = 0x200 # $] < 5.009 + FLAGS = 0xc00 # $] >= 5.009 OUTSIDE_SEQ = 0 PADLIST = 0x0 OUTSIDE = 0x0 \\(null\\)');