-# OptreeCheck.pm
-# package-less .pm file allows 'use OptreeCheck';
+# non-package OptreeCheck.pm
+# pm allows 'use OptreeCheck', which also imports
+# no package decl means all functions defined into main
# otherwise, it's like "require './test.pl'"
=head1 NAME
-OptreeCheck - check optrees
+OptreeCheck - check optrees as rendered by B::Concise
=head1 SYNOPSIS
OptreeCheck supports regression testing of perl's parser, optimizer,
-bytecode generator, via a single function: checkOptree(%args).
-
- checkOptree(name => "your title here",
- bcopts => '-exec', # $opt or \@opts, passed to BC::compile
- code => sub {my $a}, # must be CODE ref
- # prog => 'sort @a', # run in subprocess, aka -MO=Concise
- # skip => 1, # skips test
- # todo => 'excuse', # anticipated failures
- # fail => 1 # fails (by redirecting result)
- # debug => 1, # turns on regex debug for match test !!
- # retry => 1 # retry with debug on test failure
- expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+bytecode generator, via a single function: checkOptree(%args). It
+invokes B::Concise upon sample code, and checks that it 'agrees' with
+reference renderings.
+
+ checkOptree (
+ name => "test-name', # optional, (synth from others)
+
+ # 2 kinds of code-under-test: must provide 1
+ code => sub {my $a}, # coderef, or source (wrapped and evald)
+ prog => 'sort @a', # run in subprocess, aka -MO=Concise
+
+ bcopts => '-exec', # $opt or \@opts, passed to BC::compile
+ # errs => '.*', # match against any emitted errs, -w warnings
+ # skip => 1, # skips test
+ # todo => 'excuse', # anticipated failures
+ # fail => 1 # force fail (by redirecting result)
+ # debug => 1, # turns on regex debug for match test !!
+ # retry => 1 # retry with debug on test failure
+
+ expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT' );
# 1 <;> nextstate(main 45 optree.t:23) v
# 2 <0> padsv[$a:45,46] M/LVINTRO
# 3 <1> leavesub[1 ref] K/REFC,1
=head1 checkOptree(%in) Overview
-Runs code or prog through B::Concise, and captures its rendering.
+optreeCheck() calls getRendering(), which runs code or prog through
+B::Concise, and captures its rendering.
-Calls mkCheckRex() to produce a regex which will match the expected
-rendering, and fail when it doesn't match.
+It then calls mkCheckRex() to produce a regex which will match the
+expected rendering, and fail when it doesn't match.
+
+Finally, it compares the 2; like($rendering,/$regex/,$testname).
-Also calls like($out,/$regex/,$name), and thereby plugs into the test.pl
-framework.
=head1 checkOptree(%Args) API
Accepts %Args, with following requirements and actions:
-expect and expect_nt required, not empty, not whitespace. Its a fatal
-error, because false positives are BAD.
-
-Either code or prog must be present.
-
-prog is some source code, and is passed through via runperl, to B::Concise
-like this: (bcopts are fixed up for cmdline)
+Either code or prog must be present. prog is some source code, and is
+passed through via test.pl:runperl, to B::Concise like this: (bcopts
+are fixed up for cmdline)
'./perl -w -MO=Concise,$bcopts_massaged -e $src'
code is a subref, or $src, like above. If it's not a subref, it's
-treated like source, and wrapped as a subroutine, and passed to
-B::Concise::compile():
+treated like source-code, is wrapped as a subroutine, and is passed to
+B::Concise::compile().
$subref = eval "sub{$src}";
+ B::Concise::compile($subref).
+
+expect and expect_nt are the reference optree renderings. Theyre
+required, except when the code/prog compilation fails.
-I suppose I should also explain these more, but..
+I suppose I should also explain these more, but they seem obvious.
# prog => 'sort @a', # run in subprocess, aka -MO=Concise
+ # noanchors => 1, # no /^$/. needed for 1-liners like above
+
# skip => 1, # skips test
- # todo => 'excuse', # anticipated failures
- # fail => 1 # fails (by redirecting result)
+ # todo => 'excuse', # anticipated failures
+ # fail => 1 # fails (by redirecting result)
# debug => 1, # turns on regex debug for match test !!
# retry => 1 # retry with debug on test failure
-=head1 Usage Philosophy
+=head1 Test Philosophy
2 platforms --> 2 reftexts: You want an accurate test, independent of
-which platform youre on. This is obvious in retrospect, but ..
-
-I started this with 1 reftext, and tried to use it to construct regexs
-for both platforms. This is extra complexity, trying to build a
-single regex for both cases makes the regex more complicated, and
-harder to get 'right'.
+which platform you're on. So, two refdata properties, 'expect' and
+'expect_nt', carry renderings taken from threaded and non-threaded
+builds. This has several benefits:
-Having 2 references also allows various 'tests', really explorations
-currently. At the very least, having 2 samples side by side allows
-inspection and aids understanding of optrees.
+ 1. native reference data allows closer matching by regex.
+ 2. samples can be eyeballed to grok t-nt differences.
+ 3. data can help to validate mkCheckRex() operation.
+ 4. can develop regexes which accomodate t-nt differences.
+ 5. can test with both native and cross+converted regexes.
Cross-testing (expect_nt on threaded, expect on non-threaded) exposes
differences in B::Concise output, so mkCheckRex has code to do some
name: The test name. May be augmented by a label, which is built from
important params, and which helps keep names in sync with whats being
-tested.
+tested.'
=cut
fail => 'force all test to fail, print to stdout',
dump => 'dump cmdline arg prcessing',
rexpedant => 'try tighter regex, still buggy',
+ noanchors => 'dont anchor match rex',
help => 0, # 1 ends in die
# array values are one-of selections, with 1st value as default
- # tbc: 1st value is help, 2nd is default
testmode => [qw/ native cross both /],
+
+ # fixup for VMS, cygwin, which dont have stderr b4 stdout
+ # 2nd value is used as help-str, 1st val (still) default
+
+ rxnoorder => [1, 'if 1, dont req match on -e lines, and -banner',0],
+ strip => [1, 'if 1, catch errs and remove from renderings',0],
+ stripv => 'if strip&&1, be verbose about it',
+ errs => 'expected compile errs',
);
-our $threaded = 1 if $Config::Config{usethreads};
+# Not sure if this is too much cheating. Officially we say that
+# $Config::Config{usethreads} is true if some sort of threading is in use,
+# in which case we ought to be able to use it in place of the || below.
+# However, it is now possible to Configure perl with "threads" but neither
+# ithreads or 5005threads, which forces the re-entrant APIs, but no perl
+# user visible threading. This seems to have the side effect that most of perl
+# doesn't think that it's threaded, hence the ops aren't threaded either.
+# Not sure if this is actually a "supported" configuration, but given that
+# ponie uses it, it's going to be used by something official at least in the
+# interim. So it's nice for tests to all pass.
+our $threaded = 1
+ if $Config::Config{useithreads} || $Config::Config{use5005threads};
our $platform = ($threaded) ? "threaded" : "plain";
our $thrstat = ($threaded) ? "threaded" : "nonthreaded";
cross => [ !($threaded) ? 'expect' : 'expect_nt'],
expect => [ 'expect' ],
expect_nt => [ 'expect_nt' ],
- );
+ );
our %msgs # announce cross-testing.
= (
# override with 'foo' if 'opt=foo' appears
grep s/$opt=(.*)/$gOpts{$opt}=$1/e, @ARGV;
}
- }
+ }
print("$0 heres current state:\n", Dumper \%gOpts)
if $gOpts{help} or $gOpts{dump};
exit if $gOpts{help};
}
+# the above arg-handling cruft should be replaced by a Getopt call
##################################
# API
print "checkOptree args: ",Dumper \%in if $in{dump};
SKIP: {
+ label(\%in);
skip($in{name}, 1) if $in{skip};
+
+ # cpy globals into each test
+ foreach $k (keys %gOpts) {
+ if ($gOpts{$k}) {
+ $in{$k} = $gOpts{$k} unless $in{$k};
+ }
+ }
+ #die "no reftext found for $want: $in->{name}" unless $str;
+
return runSelftest(\%in) if $gOpts{selftest};
- my $rendering = getRendering(\%in); # get the actual output
+ my ($rendering,@errs) = getRendering(\%in); # get the actual output
+
+ if ($in->{errs}) {
+ if (@errs) {
+ like ("@errs", qr/$in->{errs}\s*/, "$in->{name} - matched expected errs");
+ next;
+ }
+ }
fail("FORCED: $in{name}:\n$rendering") if $gOpts{fail}; # silly ?
# Test rendering against ..
+ TODO:
foreach $want (@{$modes{$gOpts{testmode}}}) {
+ local $TODO = $in{todo} if $in{todo};
- my $rex = mkCheckRex(\%in,$want);
+ my ($rex,$txt,$rexstr) = mkCheckRex(\%in,$want);
my $cross = $msgs{"$want-$thrstat"};
# bad is anticipated failure on cross testing ONLY
my $bad = (0 or ( $cross && $in{crossfail})
or (!$cross && $in{fail})
- or 0);
+ or 0); # no undefs! pedant
# couldn't bear to pass \%in to likeyn
$res = mylike ( # custom test mode stuff
[ !$bad,
- $in{retry} || $gOpts{retry},
- $in{debug} || $gOpts{retrydbg}
+ $in{retry} || $gOpts{retry},
+ $in{debug} || $gOpts{retrydbg},
+ $rexstr,
],
# remaining is std API
- $rendering, qr/$rex/ms, "$cross $in{name}")
+ $rendering, qr/$rex/ms, "$cross $in{name} $in{label}")
|| 0;
printhelp(\%in, $rendering, $rex);
}
sub label {
# may help get/keep test output consistent
my ($in) = @_;
- $in->{label} = join(',', map {"$_=>$in->{$_}"}
- qw( bcopts name prog code ));
+ return if $in->{name};
+
+ my $buf = (ref $in->{bcopts})
+ ? join(',', @{$in->{bcopts}}) : $in->{bcopts};
+
+ foreach (qw( note prog code )) {
+ $buf .= " $_: $in->{$_}" if $in->{$_} and not ref $in->{$_};
+ }
+ return $in->{label} = $buf;
}
sub testCombo {
my $in = @_;
my @cases;
foreach $want (@{$modes{$gOpts{testmode}}}) {
-
- push @cases, [ %in,
- ];
+ push @cases, [ %in ]
}
return @cases;
}
# couldn't bear to pass \%in to likeyn
$res = mylike ( [ !$bad,
$in->{retry} || $gOpts{retry},
- $in->{debug} || $gOpts{retrydbg}
+ $in->{debug} || $gOpts{retrydbg},
+ #label($in)
],
$rendering, qr/$rex/ms, "$cross $in{name}")
|| 0;
sub mylike {
# note dependence on unlike()
my ($control) = shift;
- my ($yes,$retry,$debug) = @$control; # or dies
+ my ($yes,$retry,$debug,$postmortem) = @$control; # or dies
my ($got, $expected, $name, @mess) = @_; # pass thru mostly
die "unintended usage, expecting Regex". Dumper \@_
unless ref $_[1] eq 'Regexp';
+ #ok($got=~/$expected/, "wow");
+
# same as A ^ B, but B has side effects
my $ok = ( (!$yes and unlike($got, $expected, $name, @mess))
or ($yes and like($got, $expected, $name, @mess)));
+ if (not $ok and $postmortem) {
+ # split rexstr into units that should eat leading lines.
+ my @rexs = map qr/^$_/, split (/\n/,$postmortem);
+ foreach my $rex (@rexs) {
+ #$got =~ s/($rex)/ate: $1/msg; # noisy
+ $got =~ s/($rex)\n//msg; # remove matches
+ }
+ print "these lines not matched:\n$got\n";
+ }
+
if (not $ok and $retry) {
- # redo, perhaps with use re debug
+ # redo, perhaps with use re debug - NOT ROBUST
eval "use re 'debug'" if $debug;
$ok = (!$yes and unlike($got, $expected, "(RETRY) $name", @mess)
or $yes and like($got, $expected, "(RETRY) $name", @mess));
my @opts = get_bcopts($in);
my $rendering = ''; # suppress "Use of uninitialized value in open"
+ my @errs; # collect errs via
+
if ($in->{prog}) {
$rendering = runperl( switches => ['-w',join(',',"-MO=Concise",@opts)],
prog => $in->{prog}, stderr => 1,
- ); #verbose => 1);
+ ); # verbose => 1);
} else {
my $code = $in->{code};
unless (ref $code eq 'CODE') {
# treat as source, and wrap
$code = eval "sub { $code }";
- die "$@ evaling code 'sub { $in->{code} }'\n"
- unless ref $code eq 'CODE';
+ # return errors
+ push @errs, $@ if $@;
}
# set walk-output b4 compiling, which writes 'announce' line
walk_output(\$rendering);
B::Concise::reset_sequence();
$opwalker->();
}
- return $rendering;
+ if ($in->{strip}) {
+ $rendering =~ s/(B::Concise::compile.*?\n)//;
+ print "stripped from rendering <$1>\n" if $1 and $in->{stripv};
+
+ while ($rendering =~ s/^(.*?-e line .*?\n)//g) {
+ print "stripped <$1>\n" if $in->{stripv};
+ push @errs, $1;
+ }
+ $rendering =~ s/-e syntax OK\n//;
+ $rendering =~ s/-e had compilation errors\.\n//;
+ }
+ return $rendering, @errs;
}
sub get_bcopts {
return @opts;
}
+=head1 mkCheckRex
+
+mkCheckRex receives the full testcase object, and constructs a regex.
+1st, it selects a reftxt from either the expect or expect_nt items.
+
+Once selected, the reftext is massaged & converted into a Regex that
+accepts 'good' concise renderings, with appropriate input variations,
+but is otherwise as strict as possible. For example, it should *not*
+match when opcode flags change, or when optimizations convert an op to
+an ex-op.
+
+selection is driven by platform mostly, but also by test-mode, which
+rather complicates the code. this is worsened by the potential need
+to make platform specific conversions on the reftext.
+
+=head2 match criteria
+
+Opcode arguments (text within braces) are disregarded for matching
+purposes. This loses some info in 'add[t5]', but greatly simplifys
+matching 'nextstate(main 22 (eval 10):1)'. Besides, we are testing
+for regressions, not for complete accuracy.
+
+The regex is anchored by default, but can be suppressed with
+'noanchors', allowing 1-liner tests to succeed if opcode is found.
+
+=cut
+
# needless complexity due to 'too much info' from B::Concise v.60
my $announce = 'B::Concise::compile\(CODE\(0x[0-9a-f]+\)\)';;
my $str = $in->{expect} || $in->{expect_nt}; # standard bias
$str = $in->{$want} if $want; # stated pref
- die "no reftext found for $want: $in->{name}" unless $str;
#fail("rex-str is empty, won't allow false positives") unless $str;
$str =~ s/^\# //mg; # ease cut-paste testcase authoring
my $reftxt = $str; # extra return val !!
- unless ($gOpts{rexpedant}) {
- # convert all (args) and [args] to temporary '____'
- $str =~ s/(\(.*?\))/____/msg;
- $str =~ s/(\[.*?\])/____/msg;
-
- # escape remaining metachars. manual \Q (doesnt escape '+')
- $str =~ s/([\[\]()*.\$\@\#])/\\$1/msg;
- #$str =~ s/([*.\$\@\#])/\\$1/msg;
-
- # now replace '____' with something that matches both.
- # bracing style agnosticism is important here, it makes many
- # threaded / non-threaded diffs irrelevant
- $str =~ s/____/(\\[.*?\\]|\\(.*?\\))/msg; # capture in case..
-
- # no mysterious failures in debugger
- $str =~ s/(?:next|db)state/(?:next|db)state/msg;
- }
- else {
- # precise/pedantic way - only wildcard nextate, leavesub
-
- # escape some literals
- $str =~ s/([*.\$\@\#])/\\$1/msg;
+ # convert all (args) and [args] to temp forms wo bracing
+ $str =~ s/\[(.*?)\]/__CAPSQR$1__/msg;
+ $str =~ s/\((.*?)\)/__CAPRND$1__/msg;
+ $str =~ s/\((.*?)\)/__CAPRND$1__/msg; # nested () in nextstate
+
+ # escape bracing, etc.. manual \Q (doesnt escape '+')
+ $str =~ s/([\[\]()*.\$\@\#\|{}])/\\$1/msg;
+
+ # now replace temp forms with original, preserving reference bracing
+ $str =~ s/__CAPSQR(.*?)__\b/\\[$1\\]/msg; # \b is important
+ $str =~ s/__CAPRND(.*?)__\b/\\($1\\)/msg;
+ $str =~ s/__CAPRND(.*?)__\b/\\($1\\)/msg; # nested () in nextstate
+
+ # no 'invisible' failures in debugger
+ $str =~ s/(?:next|db)state(\\\(.*?\\\))/(?:next|db)state(.*?)/msg;
+ # widened for -terse mode
+ $str =~ s/(?:next|db)state/(?:next|db)state/msg;
+
+ # don't care about:
+ $str =~ s/:-?\d+,-?\d+/:-?\\d+,-?\\d+/msg; # FAKE line numbers
+ $str =~ s/match\\\(.*?\\\)/match\(.*?\)/msg; # match args
+ $str =~ s/(0x[0-9A-Fa-f]+)/0x[0-9A-Fa-f]+/msg; # hexnum values
+ $str =~ s/".*?"/".*?"/msg; # quoted strings
+
+ $str =~ s/(\d refs?)/\\d refs?/msg;
+ $str =~ s/leavesub \[\d\]/leavesub [\\d]/msg; # for -terse
- # nextstate. replace args, and work under debugger
- $str =~ s/(?:next|db)state\(.*?\)/(?:next|db)state\\(.*?\\)/msg;
-
- # leavesub refcount changes, dont care
- $str =~ s/leavesub\[.*?\]/leavesub[.*?]/msg;
-
- # wildcard-ify all [contents]
- $str =~ s/\[.*?\]/[.*?]/msg; # add capture ?
-
- # make [] literal now, keeping .* for contents
- $str =~ s/([\[\]])/\\$1/msg;
- }
- # threaded <--> non-threaded transforms ??
-
- if (not $Config::Config{usethreads}) {
- # written for T->NT transform
- # $str =~ s/<\\#>/<\\\$>/msg; # GV on pad, a threads thing ?
- $str =~ s/PADOP/SVOP/msg; # fix terse output diffs
- }
croak "no reftext found for $want: $in->{name}"
unless $str =~ /\w+/; # fail unless a real test
# $str = '.*' if 1; # sanity test
# $str .= 'FAIL' if 1; # sanity test
- # tabs fixup
- $str =~ s/\t/ +/msg; # not \s+
-
+ # allow -eval, banner at beginning of anchored matches
+ $str = "(-e .*?)?(B::Concise::compile.*?)?\n" . $str
+ unless $in->{noanchors} or $in->{rxnoorder};
+
eval "use re 'debug'" if $debug;
- my $qr = qr/$str/;
+ my $qr = ($in->{noanchors}) ? qr/$str/ms : qr/^$str$/ms ;
no re 'debug';
- return ($qr, $reftxt) if wantarray;
+ return ($qr, $reftxt, $str) if wantarray;
return $qr;
}
+
sub printhelp {
+ # crufty - may be still useful
my ($in, $rendering, $rex) = @_;
- print "<$rendering>\nVS\n<$reftext>\n" if $gOpts{vbasic};
+ print "<$rendering>\nVS\n<$rex>\n" if $gOpts{vbasic};
# save this output to afile, edit out 'ok's and 1..N
# then perl -d afile, and add re 'debug' to suit.
- print("\$str = q{$rendering};\n".
- "\$rex = qr{$reftext};\n".
- "print \"\$str =~ m{\$rex}ms \";\n".
+ print("\$str = q%$rendering%;\n".
+ "\$rex = qr%$rex%;\n\n".
+ #"print \"\$str =~ m%\$rex%ms \";\n".
"\$str =~ m{\$rex}ms or print \"doh\\n\";\n\n")
if $in{rextract} or $gOpts{rextract};
}
-1;
-__END__
+#########################
+# support for test writing
-=head1 mkCheckRex
+sub preamble {
+ my $testct = shift || 1;
+ return <<EO_HEADER;
+#!perl
-mkCheckRex receives the full testcase object, and constructs a regex.
-1st, it selects a reftxt from either the expect or expect_nt items.
+BEGIN {
+ chdir q(t);
+ \@INC = qw(../lib ../ext/B/t);
+ require q(./test.pl);
+}
+use OptreeCheck;
+plan tests => $testct;
-Once selected, reftext massaged & convert into a Regex that accepts
-'good' concise renderings, with appropriate input variations, but is
-otherwize as strict as possible. For example, it should *not* match
-when opcode flags change, or when optimizations convert an op to an
-ex-op.
+EO_HEADER
-=head2 match criteria
+}
-Opcode arguments (text within braces) are disregarded for matching
-purposes. This loses some info in 'add[t5]', but greatly simplifys
-matching 'nextstate(main 22 (eval 10):1)'. Besides, we are testing
-for regressions, not for complete accuracy.
+sub OptreeCheck::wrap {
+ my $code = shift;
+ $code =~ s/(?:(\#.*?)\n)//gsm;
+ $code =~ s/\s+/ /mgs;
+ chomp $code;
+ return unless $code =~ /\S/;
+ my $comment = $1;
+
+ my $testcode = qq{
+
+checkOptree(note => q{$comment},
+ bcopts => q{-exec},
+ code => q{$code},
+ expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
+ThreadedRef
+EOT_EOT
+NonThreadRef
+EONT_EONT
+
+};
+ return $testcode;
+}
-The regex is unanchored, allowing success on simple expectations, such
-as one with a single 'print' opcode.
+sub OptreeCheck::gentest {
+ my ($code,$opts) = @_;
+ my $rendering = getRendering({code => $code});
+ my $testcode = OptreeCheck::wrap($code);
+ return unless $testcode;
+
+ # run the prog, capture 'reference' concise output
+ my $preamble = preamble(1);
+ my $got = runperl( prog => "$preamble $testcode", stderr => 1,
+ #switches => ["-I../ext/B/t", "-MOptreeCheck"],
+ ); #verbose => 1);
+
+ # extract the 'reftext' ie the got 'block'
+ if ($got =~ m/got \'.*?\n(.*)\n\# \'\n\# expected/s) {
+ my $reftext = $1;
+ #and plug it into the test-src
+ if ($threaded) {
+ $testcode =~ s/ThreadedRef/$reftext/;
+ } else {
+ $testcode =~ s/NonThreadRef/$reftext/;
+ }
+ my $b4 = q{expect => <<EOT_EOT, expect_nt => <<EONT_EONT};
+ my $af = q{expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'};
+ $testcode =~ s/$b4/$af/;
+
+ my $got;
+ if ($internal_retest) {
+ $got = runperl( prog => "$preamble $testcode", stderr => 1,
+ #switches => ["-I../ext/B/t", "-MOptreeCheck"],
+ verbose => 1);
+ print "got: $got\n";
+ }
+ return $testcode;
+ }
+ return '';
+}
-=head2 complicating factors
-Note that %in may seem overly complicated, but it's needed to allow
-mkCheckRex to better support selftest,
+sub OptreeCheck::processExamples {
+ my @files = @_;
+ # gets array of paragraphs, which should be tests.
-The emerging complexity is that mkCheckRex must choose which refdata
-to use as a template for the regex being constructed. This feels like
-selection mechanics being duplicated.
+ foreach my $file (@files) {
+ open (my $fh, $file) or die "cant open $file: $!\n";
+ $/ = "";
+ my @chunks = <$fh>;
+ print preamble (scalar @chunks);
+ foreach $t (@chunks) {
+ print "\n\n=for gentest\n\n# chunk: $t=cut\n\n";
+ print OptreeCheck::gentest ($t);
+ }
+ }
+}
-=head1 FEATURES, BUGS, ENHANCEMENTS
+# OK - now for the final insult to your good taste...
-Hey, they're the same thing now, modulo heisen-phase-shifting, and the
-probe used to observe them.
+if ($0 =~ /OptreeCheck\.pm/) {
-=head1 Test Data
+ #use lib 't';
+ require './t/test.pl';
-Test cases were recently doubled, by adding a 2nd ref-data property;
-expect and expect_nt carry renderings taken from threaded and
-non-threaded builds. This addition has several benefits:
+ # invoked as program. Work like former gentest.pl,
+ # ie read files given as cmdline args,
+ # convert them to usable test files.
- 1. native reference data allows closer matching by regex.
- 2. samples can be eyeballed to grok t-nt differences.
- 3. data can help to validate mkCheckRex() operation.
- 4. can develop code to smooth t-nt differences.
- 5. can test with both native and cross+converted rexes
+ require Getopt::Std;
+ Getopt::Std::getopts('') or
+ die qq{ $0 sample-files* # no options
+
+ expecting filenames as args. Each should have paragraphs,
+ these are converted to checkOptree() tests, and printed to
+ stdout. Redirect to file then edit for test. \n};
+
+ OptreeCheck::processExamples(@ARGV);
+}
+
+1;
+
+__END__
+
+=head1 TEST DEVELOPMENT SUPPORT
+
+This optree regression testing framework needs tests in order to find
+bugs. To that end, OptreeCheck has support for developing new tests,
+according to the following model:
+
+ 1. write a set of sample code into a single file, one per
+ paragraph. f_map and f_sort in ext/B/t/ are examples.
+
+ 2. run OptreeCheck as a program on the file
+
+ ./perl -Ilib ext/B/t/OptreeCheck.pm -w ext/B/t/f_map
+ ./perl -Ilib ext/B/t/OptreeCheck.pm -w ext/B/t/f_sort
+
+ gentest reads the sample code, runs each to generate a reference
+ rendering, folds this rendering into an optreeCheck() statement,
+ and prints it to stdout.
+
+ 3. run the output file as above, redirect to files, then rerun on
+ same build (for sanity check), and on thread-opposite build. With
+ editor in 1 window, and cmd in other, it's fairly easy to cut-paste
+ the gots into the expects, easier than running step 2 on both
+ builds then trying to sdiff them together.
-Enhancements:
+=head1 TODO
-Tests should specify both 'expect' and 'expect_nt', making the
-distinction now will allow a range of behaviors, in escalating
-thoroughness. This variable is called provenance, indicating where
-the reftext came from.
+There's a considerable amount of cruft in the whole arg-handling setup.
+I'll replace / strip it before 5.10
-build_only: tests which dont have the reference-sample of the
-right provenance will be skipped. NO GOOD.
+Treat %in as a test object, interwork better with Test::*
-prefer_expect: This is implied standard, as all tests done thus far
-started here. One way t->nt conversions is done, based upon Config.
+Refactor mkCheckRex() and selfTest() to isolate the selftest,
+crosstest, etc selection mechanics.
-activetest: do cross-testing when test-case has both, ie also test
-'expect_nt' references on threaded builds. This is aggressive, and is
-intended to seek out t<->nt differences. if mkCheckRex knows
-provenance and Config, it can do 2 way t<->nt conversions.
+improve retry, retrydbg, esp. it's control of eval "use re debug".
+This seems to work part of the time, but isn't stable enough.
-activemapping: This builds upon activetest by controlling whether
-t<->nt conversions are done, and allows simpler verification that each
-conversion step is indeed necessary.
+=head1 CAVEATS
-pedantic: this fails if tests dont have both, whereas above doesn't care.
+This code is purely for testing core. While checkOptree feels flexible
+enough to be stable, the whole selftest framework is subject to change
+w/o notice.
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff