diff options
Diffstat (limited to 'gnu/usr.bin/perl/ext/B/t')
| -rw-r--r-- | gnu/usr.bin/perl/ext/B/t/OptreeCheck.pm | 1017 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/f_map.t | 198 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/f_sort.t | 305 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/optree_check.t | 110 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/optree_concise.t | 115 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/optree_samples.t | 717 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/optree_sort.t | 188 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/optree_specials.t | 441 | ||||
| -rwxr-xr-x | gnu/usr.bin/perl/ext/B/t/optree_varinit.t | 190 |
9 files changed, 1337 insertions, 1944 deletions
diff --git a/gnu/usr.bin/perl/ext/B/t/OptreeCheck.pm b/gnu/usr.bin/perl/ext/B/t/OptreeCheck.pm index 0537a8d7a86..f8e2995346a 100644 --- a/gnu/usr.bin/perl/ext/B/t/OptreeCheck.pm +++ b/gnu/usr.bin/perl/ext/B/t/OptreeCheck.pm @@ -1,24 +1,7 @@ -package OptreeCheck; -use parent 'Exporter'; -use strict; -use warnings; -use vars qw($TODO $Level $using_open); -require "test.pl"; - -our $VERSION = '0.11'; - -# now export checkOptree, and those test.pl functions used by tests -our @EXPORT = qw( checkOptree plan skip skip_all pass is like unlike - require_ok runperl tempfile); - - -# The hints flags will differ if ${^OPEN} is set. -# The approach taken is to put the hints-with-open in the golden results, and -# flag that they need to be taken out if ${^OPEN} is set. - -if (((caller 0)[10]||{})->{'open<'}) { - $using_open = 1; -} +# 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 @@ -26,43 +9,27 @@ OptreeCheck - check optrees as rendered by B::Concise =head1 SYNOPSIS -OptreeCheck supports 'golden-sample' regression testing of perl's -parser, optimizer, bytecode generator, via a single function: -checkOptree(%in). - -It invokes B::Concise upon the sample code, checks that the rendering -'agrees' with the golden sample, and reports mismatches. - -Additionally, the module processes @ARGV (which is typically unused in -the Core test harness), and thus provides a means to run the tests in -various modes. - -=head1 EXAMPLE - - # your test file - use OptreeCheck; - plan tests => 1; +OptreeCheck supports regression testing of perl's parser, optimizer, +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, made from others if not given + name => "test-name', # optional, (synth from others) - # code-under-test: must provide 1 of them + # 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 => 'Name "main::a" used only once: possible typo at -e line 1.', - # str, regex, [str+] [regex+], - - # various test options + 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 - # the 'golden-sample's, (must provide both) - - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT' ); # start HERE-DOCS + 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 @@ -72,212 +39,126 @@ various modes. # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT - __END__ - -=head2 Failure Reports - - Heres a sample failure, as induced by the following command. - Note the argument; option=value, after the test-file, more on that later - - $> PERL_CORE=1 ./perl ext/B/t/optree_check.t testmode=cross - ... - ok 19 - canonical example w -basic - not ok 20 - -exec code: $a=$b+42 - # Failed at test.pl line 249 - # got '1 <;> nextstate(main 600 optree_check.t:208) v - # 2 <#> gvsv[*b] s - # 3 <$> const[IV 42] s - # 4 <2> add[t3] sK/2 - # 5 <#> gvsv[*a] s - # 6 <2> sassign sKS/2 - # 7 <1> leavesub[1 ref] K/REFC,1 - # ' - # expected /(?ms-xi:^1 <;> (?:next|db)state(.*?) v - # 2 <\$> gvsv\(\*b\) s - # 3 <\$> const\(IV 42\) s - # 4 <2> add\[t\d+\] sK/2 - # 5 <\$> gvsv\(\*a\) s - # 6 <2> sassign sKS/2 - # 7 <1> leavesub\[\d+ refs?\] K/REFC,1 - # $)/ - # got: '2 <#> gvsv[*b] s' - # want: (?^:2 <\$> gvsv\(\*b\) s) - # got: '3 <$> const[IV 42] s' - # want: (?^:3 <\$> const\(IV 42\) s) - # got: '5 <#> gvsv[*a] s' - # want: (?^:5 <\$> gvsv\(\*a\) s) - # remainder: - # 2 <#> gvsv[*b] s - # 3 <$> const[IV 42] s - # 5 <#> gvsv[*a] s - # these lines not matched: - # 2 <#> gvsv[*b] s - # 3 <$> const[IV 42] s - # 5 <#> gvsv[*a] s - -Errors are reported 3 different ways; - -The 1st form is directly from test.pl's like() and unlike(). Note -that this form is used as input, so you can easily cut-paste results -into test-files you are developing. Just make sure you recognize -insane results, to avoid canonizing them as golden samples. - -The 2nd and 3rd forms show only the unexpected results and opcodes. -This is done because it's blindingly tedious to find a single opcode -causing the failure. 2 different ways are done in case one is -unhelpful. - -=head1 TestCase Overview - -checkOptree(%tc) constructs a testcase object from %tc, and then calls -methods which eventually call test.pl's like() to produce test -results. - -=head2 getRendering - -getRendering() runs code or prog or progfile through B::Concise, and -captures its rendering. Errors emitted during rendering are checked -against expected errors, and are reported as diagnostics by default, -or as failures if 'report=fail' cmdline-option is given. - -prog is run in a sub-shell, with $bcopts passed through. This is the way -to run code intended for main. The code arg in contrast, is always a -CODEREF, either because it starts that way as an arg, or because it's -wrapped and eval'd as $sub = sub {$code}; - -=head2 mkCheckRex - -mkCheckRex() selects the golden-sample for the threaded-ness of the -platform, and produces a regex which matches the expected rendering, -and fails when it doesn't match. - -The regex includes 'workarounds' which accommodate expected rendering -variations. These include: - - string constants # avoid injection - line numbers, etc # args of nexstate() - hexadecimal-numbers - - pad-slot-assignments # for 5.8 compat, and testmode=cross - (map|grep)(start|while) # for 5.8 compat - -=head2 mylike - -mylike() calls either unlike() or like(), depending on -expectations. Mismatch reports are massaged, because the actual -difference can easily be lost in the forest of opcodes. - -=head1 checkOptree API and Operation - -Since the arg is a hash, the api is wide-open, and this really is -about what elements must be or are in the hash, and what they do. %tc -is passed to newTestCase(), the ctor, which adds in %proto, a global -prototype object. - -=head2 name => STRING - -If name property is not provided, it is synthesized from these params: -bcopts, note, prog, code. This is more convenient than trying to do -it manually. - -=head2 code or prog or progfile - -Either code or prog or progfile must be present. - -=head2 prog => $perl_source_string - -prog => $src provides a snippet of code, which is run in a sub-process, -via test.pl:runperl, and through B::Concise like so: +=head1 checkOptree(%in) Overview - './perl -w -MO=Concise,$bcopts_massaged -e $src' +optreeCheck() calls getRendering(), which runs code or prog through +B::Concise, and captures its rendering. -=head2 progfile => $perl_script +It then calls mkCheckRex() to produce a regex which will match the +expected rendering, and fail when it doesn't match. -progfile => $file provides a file containing a snippet of code which is -run as per the prog => $src example above. +Finally, it compares the 2; like($rendering,/$regex/,$testname). -=head2 code => $perl_source_string || CODEREF -The $code arg is passed to B::Concise::compile(), and run in-process. -If $code is a string, it's first wrapped and eval'd into a $coderef. -In either case, $coderef is then passed to B::Concise::compile(): +=head1 checkOptree(%Args) API - $subref = eval "sub{$code}"; - $render = B::Concise::compile($subref)->(); +Accepts %Args, with following requirements and actions: -=head2 expect and expect_nt +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) -expect and expect_nt args are the B<golden-sample> renderings, and are -sampled from known-ok threaded and un-threaded bleadperl (5.9.1) builds. -They're both required, and the correct one is selected for the platform -being tested, and saved into the synthesized property B<wanted>. + './perl -w -MO=Concise,$bcopts_massaged -e $src' -Individual sample lines may be suffixed with whitespace followed -by (<|<=|==|>=|>)5.nnnn (up to two times) to -select that line only for the listed perl -version; the whitespace and conditional are stripped. +code is a subref, or $src, like above. If it's not a subref, it's +treated like source-code, is wrapped as a subroutine, and is passed to +B::Concise::compile(). -=head2 bcopts => $bcopts || [ @bcopts ] + $subref = eval "sub{$src}"; + B::Concise::compile($subref). -When getRendering() runs, it passes bcopts into B::Concise::compile(). -The bcopts arg can be a single string, or an array of strings. +expect and expect_nt are the reference optree renderings. Theyre +required, except when the code/prog compilation fails. -=head2 errs => $err_str_regex || [ @err_str_regexs ] +I suppose I should also explain these more, but they seem obvious. -getRendering() processes the code or prog or progfile arg under warnings, -and both parsing and optree-traversal errors are collected. These are -validated against the one or more errors you specify. + # prog => 'sort @a', # run in subprocess, aka -MO=Concise + # noanchors => 1, # no /^$/. needed for 1-liners like above -=head1 testcase modifier properties + # 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 -These properties are set as %tc parameters to change test behavior. +=head1 Test Philosophy -=head2 skip => 'reason' +2 platforms --> 2 reftexts: You want an accurate test, independent of +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: -invokes skip('reason'), causing test to skip. + 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. -=head2 todo => 'reason' +Cross-testing (expect_nt on threaded, expect on non-threaded) exposes +differences in B::Concise output, so mkCheckRex has code to do some +cross-test manipulations. This area needs more work. + +=head1 Test Modes -invokes todo('reason') +One consequence of a single-function API is difficulty controlling +test-mode. Ive chosen for now to use a package hash, %gOpts, to store +test-state. These properties alter checkOptree() function, either +short-circuiting to selftest, or running a loop that runs the testcase +2^N times, varying conditions each time. (current N is 2 only). -=head2 fail => 1 +So Test-mode is controlled with cmdline args, also called options below. +Run with 'help' to see the test-state, and how to change it. -For code arguments, this option causes getRendering to redirect the -rendering operation to STDERR, which causes the regex match to fail. +=head2 selftest -=head2 noanchors => 1 +This argument invokes runSelftest(), which tests a regex against the +reference renderings that they're made from. Failure of a regex match +its 'mold' is a strong indicator that mkCheckRex is buggy. -If set, this relaxes the regex check, which is normally pretty strict. -It's used primarily to validate checkOptree via tests in optree_check. +That said, selftest mode currently runs a cross-test too, they're not +completely orthogonal yet. See below. +=head2 testmode=cross -=head1 Synthesized object properties +Cross-testing is purposely creating a T-NT mismatch, looking at the +fallout, and tweaking the regex to deal with it. Thus tests lead to +'provably' complete understanding of the differences. -These properties are added into the test object during execution. +The tweaking appears contrary to the 2-refs philosophy, but the tweaks +will be made in conversion-specific code, which (will) handles T->NT +and NT->T separately. The tweaking is incomplete. -=head2 wanted +A reasonable 1st step is to add tags to indicate when TonNT or NTonT +is known to fail. This needs an option to force failure, so the +test.pl reporting mechanics show results to aid the user. -This stores the chosen expect expect_nt string. The OptreeCheck -object may in the future delete the raw strings once wanted is set, -thus saving space. +=head2 testmode=native -=head2 cross => 1 +This is normal mode. Other valid values are: native, cross, both. -This tag is added if testmode=cross is passed in as argument. -It causes test-harness to purposely use the wrong string. +=head2 checkOptree Notes +Accepts test code, renders its optree using B::Concise, and matches that +rendering against a regex built from one of 2 reference-renderings %in data. -=head2 checkErrs +The regex is built by mkCheckRex(\%in), which scrubs %in data to +remove match-irrelevancies, such as (args) and [args]. For example, +it strips leading '# ', making it easy to cut-paste new tests into +your test-file, run it, and cut-paste actual results into place. You +then retest and reedit until all 'errors' are gone. (now make sure you +haven't 'enshrined' a bug). -checkErrs() is a getRendering helper that verifies that expected errs -against those found when rendering the code on the platform. It is -run after rendering, and before mkCheckRex. +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.' =cut use Config; use Carp; use B::Concise qw(walk_output); +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; BEGIN { $SIG{__WARN__} = sub { @@ -286,12 +167,8 @@ BEGIN { }; } -sub import { - my $pkg = shift; - $pkg->export_to_level(1,'checkOptree', @EXPORT); - getCmdLine(); # process @ARGV -} - +# but wait - more skullduggery ! +sub OptreeCheck::import { &getCmdLine; } # process @ARGV # %gOpts params comprise a global test-state. Initial values here are # HELP strings, they MUST BE REPLACED by runtime values before use, as @@ -300,43 +177,52 @@ sub import { our %gOpts = # values are replaced at runtime !! ( # scalar values are help string + rextract => 'writes src-code todo same Optree matching', + vbasic => 'prints $str and $rex', + retry => 'retry failures after turning on re debug', + retrydbg => 'retry failures after turning on re debug', selftest => 'self-tests mkCheckRex vs the reference rendering', - + selfdbg => 'redo failing selftests with re debug', + xtest => 'extended thread/non-thread testing', fail => 'force all test to fail, print to stdout', - dump => 'dump cmdline arg processing', + 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 - # array: 2nd value is used as help-str, 1st val (still) default - help => [0, 'provides help and exits', 0], - testmode => [qw/ native cross both /], + 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 - # fixup for VMS, cygwin, which don't have stderr b4 stdout 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, array if several', + errs => 'expected compile errs', ); # 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. - +# $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"; +our ($MatchRetry,$MatchRetryDebug); # let mylike be generic +# test.pl-ish hack +*MatchRetry = \$gOpts{retry}; # but alias it into %gOpts +*MatchRetryDebug = \$gOpts{retrydbg}; # but alias it into %gOpts + our %modes = ( both => [ 'expect', 'expect_nt'], native => [ ($threaded) ? 'expect' : 'expect_nt'], @@ -348,9 +234,9 @@ our %modes = ( our %msgs # announce cross-testing. = ( # cross-platform - 'expect_nt-threaded' => " (nT on T) ", - 'expect-nonthreaded' => " (T on nT) ", - # native - nothing to say (must stay empty - used for $crosstesting) + 'expect_nt-threaded' => " (Non-threaded-ref on Threaded-build)", + 'expect-nonthreaded' => " (Threaded-ref on Non-threaded-build)", + # native - nothing to say 'expect_nt-nonthreaded' => '', 'expect-threaded' => '', ); @@ -361,7 +247,7 @@ sub getCmdLine { # import assistant print(qq{\n$0 accepts args to update these state-vars: turn on a flag by typing its name, select a value from list by typing name=val.\n }, - mydumper(\%gOpts)) + Dumper \%gOpts) if grep /help/, @ARGV; # replace values for each key !! MUST MARK UP %gOpts @@ -392,231 +278,250 @@ sub getCmdLine { # import assistant else { # handle scalars # if 'opt' is present, true - $gOpts{$opt} = (grep /^$opt/, @ARGV) ? 1 : 0; + $gOpts{$opt} = (grep /$opt/, @ARGV) ? 1 : 0; # override with 'foo' if 'opt=foo' appears grep s/$opt=(.*)/$gOpts{$opt}=$1/e, @ARGV; } } - print("$0 heres current state:\n", mydumper(\%gOpts)) + 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 -############################## -# the API (1 function) +################################## +# API sub checkOptree { - my $tc = newTestCases(@_); # ctor - my ($rendering); + my %in = @_; + my ($in, $res) = (\%in,0); # set up privates. - print "checkOptree args: ",mydumper($tc) if $tc->{dump}; + print "checkOptree args: ",Dumper \%in if $in{dump}; SKIP: { - if ($tc->{skip}) { - skip("$tc->{skip} $tc->{name}", - ($gOpts{selftest} - ? 1 - : 1 + @{$modes{$gOpts{testmode}}} - ) - ); - } + label(\%in); + skip($in{name}, 1) if $in{skip}; - return runSelftest($tc) if $gOpts{selftest}; + # 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; - $tc->getRendering(); # get the actual output - $tc->checkErrs(); + return runSelftest(\%in) if $gOpts{selftest}; - local $Level = $Level + 2; - TODO: - foreach my $want (@{$modes{$gOpts{testmode}}}) { - local $TODO = $tc->{todo} if $tc->{todo}; + my ($rendering,@errs) = getRendering(\%in); # get the actual output - $tc->{cross} = $msgs{"$want-$thrstat"}; + 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 ? - $tc->mkCheckRex($want); - $tc->mylike(); + # Test rendering against .. + TODO: + foreach $want (@{$modes{$gOpts{testmode}}}) { + local $TODO = $in{todo} if $in{todo}; + + 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); # 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}, + $rexstr, + ], + # remaining is std API + $rendering, qr/$rex/ms, "$cross $in{name} $in{label}") + || 0; + printhelp(\%in, $rendering, $rex); } } - return; + $res; } -sub newTestCases { - # make test objects (currently 1) from args (passed to checkOptree) - my $tc = bless { @_ }, __PACKAGE__ - or die "test cases are hashes"; +################# +# helpers - $tc->label(); +sub label { + # may help get/keep test output consistent + my ($in) = @_; + return if $in->{name}; - # cpy globals into each test - foreach my $k (keys %gOpts) { - if ($gOpts{$k}) { - $tc->{$k} = $gOpts{$k} unless defined $tc->{$k}; - } - } - if ($tc->{errs}) { - $tc->{errs} = [$tc->{errs}] unless ref $tc->{errs} eq 'ARRAY'; + my $buf = (ref $in->{bcopts}) + ? join(',', @{$in->{bcopts}}) : $in->{bcopts}; + + foreach (qw( note prog code )) { + $buf .= " $_: $in->{$_}" if $in->{$_} and not ref $in->{$_}; } - return $tc; + return $in->{label} = $buf; } -sub label { - # may help get/keep test output consistent - my ($tc) = @_; - return $tc->{name} if $tc->{name}; +sub testCombo { + # generate a set of test-cases from the options + my $in = @_; + my @cases; + foreach $want (@{$modes{$gOpts{testmode}}}) { + push @cases, [ %in ] + } + return @cases; +} - my $buf = (ref $tc->{bcopts}) - ? join(',', @{$tc->{bcopts}}) : $tc->{bcopts}; +sub runSelftest { + # tests the test-cases offered (expect, expect_nt) + # needs Unification with above. + my ($in) = @_; + my $ok; + foreach $want (@{$modes{$gOpts{testmode}}}) {} - foreach (qw( note prog code )) { - $buf .= " $_: $tc->{$_}" if $tc->{$_} and not ref $tc->{$_}; + for my $provenance (qw/ expect expect_nt /) { + next unless $in->{$provenance}; + my ($rex,$gospel) = mkCheckRex($in, $provenance); + return unless $gospel; + + my $cross = $msgs{"$provenance-$thrstat"}; + my $bad = (0 or ( $cross && $in->{crossfail}) + or (!$cross && $in->{fail}) + or 0); + # couldn't bear to pass \%in to likeyn + $res = mylike ( [ !$bad, + $in->{retry} || $gOpts{retry}, + $in->{debug} || $gOpts{retrydbg}, + #label($in) + ], + $rendering, qr/$rex/ms, "$cross $in{name}") + || 0; } - return $tc->{name} = $buf; + $ok; } -################# -# render and its helpers +# use re; +sub mylike { + # note dependence on unlike() + my ($control) = shift; + 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 - 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)); + + no re 'debug'; + } + return $ok; +} sub getRendering { - my $tc = shift; - fail("getRendering: code or prog or progfile is required") - unless $tc->{code} or $tc->{prog} or $tc->{progfile}; + my ($in) = @_; + die "getRendering: code or prog is required\n" + unless $in->{code} or $in->{prog}; - my @opts = get_bcopts($tc); + my @opts = get_bcopts($in); my $rendering = ''; # suppress "Use of uninitialized value in open" my @errs; # collect errs via - if ($tc->{prog}) { - $rendering = runperl( switches => ['-w',join(',',"-MO=Concise",@opts)], - prog => $tc->{prog}, stderr => 1, - ); # verbose => 1); - } elsif ($tc->{progfile}) { + if ($in->{prog}) { $rendering = runperl( switches => ['-w',join(',',"-MO=Concise",@opts)], - progfile => $tc->{progfile}, stderr => 1, + prog => $in->{prog}, stderr => 1, ); # verbose => 1); } else { - my $code = $tc->{code}; + my $code = $in->{code}; unless (ref $code eq 'CODE') { - # treat as source, and wrap into subref - # in caller's package ( to test arg-fixup, comment next line) - my $pkg = '{ package '.caller(1) .';'; - { - BEGIN { $^H = 0 } - no warnings; - $code = eval "$pkg sub { $code } }"; - } + # treat as source, and wrap + $code = eval "sub { $code }"; # return errors - if ($@) { chomp $@; push @errs, $@ } + push @errs, $@ if $@; } # set walk-output b4 compiling, which writes 'announce' line walk_output(\$rendering); - + if ($in->{fail}) { + fail("forced failure: stdout follows"); + walk_output(\*STDOUT); + } my $opwalker = B::Concise::compile(@opts, $code); die "bad BC::compile retval" unless ref $opwalker eq 'CODE'; B::Concise::reset_sequence(); $opwalker->(); - - # kludge error into rendering if its empty. - $rendering = $@ if $@ and ! $rendering; } - # separate banner, other stuff whose printing order isnt guaranteed - if ($tc->{strip}) { + if ($in->{strip}) { $rendering =~ s/(B::Concise::compile.*?\n)//; - print "stripped from rendering <$1>\n" if $1 and $tc->{stripv}; + print "stripped from rendering <$1>\n" if $1 and $in->{stripv}; - #while ($rendering =~ s/^(.*?(-e) line \d+\.)\n//g) { - while ($rendering =~ s/^(.*?(-e|\(eval \d+\).*?) line \d+\.)\n//g) { - print "stripped <$1> $2\n" if $tc->{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//; } - $tc->{got} = $rendering; - $tc->{goterrs} = \@errs if @errs; return $rendering, @errs; } sub get_bcopts { # collect concise passthru-options if any - my ($tc) = shift; + my ($in) = shift; my @opts = (); - if ($tc->{bcopts}) { - @opts = (ref $tc->{bcopts} eq 'ARRAY') - ? @{$tc->{bcopts}} : ($tc->{bcopts}); + if ($in->{bcopts}) { + @opts = (ref $in->{bcopts} eq 'ARRAY') + ? @{$in->{bcopts}} : ($in->{bcopts}); } return @opts; } -sub checkErrs { - # check rendering errs against expected errors, reduce and report - my $tc = shift; - - # check for agreement (order not important) - my (%goterrs, @missed); - @goterrs{@{$tc->{goterrs}}} = (1) x scalar @{$tc->{goterrs}} - if $tc->{goterrs}; - - foreach my $want (@{$tc->{errs}}) { - if (ref $want) { - my $seen; - foreach my $k (keys %goterrs) { - next unless $k =~ $want; - delete $goterrs{$k}; - ++$seen; - } - push @missed, $want unless $seen; - } else { - push @missed, $want unless defined delete $goterrs{$want}; - } - } - - @missed = sort @missed; - my @got = sort keys %goterrs; - - if (@{$tc->{errs}}) { - is(@missed + @got, 0, "Only got expected errors for $tc->{name}") - } else { - # @missed must be 0 here. - is(scalar @got, 0, "Got no errors for $tc->{name}") - } - _diag(join "\n", "got unexpected:", @got) if @got; - _diag(join "\n", "missed expected:", @missed) if @missed; -} - -=head1 mkCheckRex ($tc) - -It selects the correct golden-sample from the test-case object, and -converts it into a Regexp which should match against the original -golden-sample (used in selftest, see below), and on the renderings -obtained by applying the code on the perl being tested. +=head1 mkCheckRex -The 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. +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 -The selected golden-sample is massaged to eliminate various match -irrelevancies. This is done so that the tests don't fail just because -you added a line to the top of the test file. (Recall that the -renderings contain the program's line numbers). Similar cleanups are -done on "strings", hex-constants, etc. - -The need to massage is reflected in the 2 golden-sample approach of -the test-cases; we want the match to be as rigorous as possible, and -thats easier to achieve when matching against 1 input than 2. - Opcode arguments (text within braces) are disregarded for matching -purposes. This loses some info in 'add[t5]', but greatly simplifies +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. @@ -631,292 +536,79 @@ my $announce = 'B::Concise::compile\(CODE\(0x[0-9a-f]+\)\)';; sub mkCheckRex { # converts expected text into Regexp which should match against # unaltered version. also adjusts threaded => non-threaded - my ($tc, $want) = @_; - - my $str = $tc->{expect} || $tc->{expect_nt}; # standard bias - $str = $tc->{$want} if $want && $tc->{$want}; # stated pref - - die("no '$want' golden-sample found: $tc->{name}") unless $str; - - $str =~ s/^\# //mg; # ease cut-paste testcase authoring - - # strip out conditional lines - - $str =~ s{^(.*?) \s+(<|<=|==|>=|>)\s*(5\.\d+) - (?:\s+(<|<=|==|>=|>)\s*(5\.\d+))? \ *\n} - { - my ($line, $cmp, $version, $cmp2, $v2) = ($1,$2,$3,$4,$5,$6); - my $repl = ""; - if ( $cmp eq '<' ? $] < $version - : $cmp eq '<=' ? $] <= $version - : $cmp eq '==' ? $] == $version - : $cmp eq '>=' ? $] >= $version - : $cmp eq '>' ? $] > $version - : die("bad comparision '$cmp' in string [$str]\n") - and !$cmp2 || ( - $cmp2 eq '<' ? $] < $v2 - : $cmp2 eq '<=' ? $] <= $v2 - : $cmp2 eq '==' ? $] == $v2 - : $cmp2 eq '>=' ? $] >= $v2 - : $cmp2 eq '>' ? $] > $v2 - : die("bad comparision '$cmp2' in string [$str]\n") - ) - ) { - $repl = "$line\n"; - } - $repl; - }gemx; + my ($in, $want) = @_; + eval "no re 'debug'"; + + my $str = $in->{expect} || $in->{expect_nt}; # standard bias + $str = $in->{$want} if $want; # stated pref - $tc->{wantstr} = $str; + #fail("rex-str is empty, won't allow false positives") unless $str; - # make targ args wild - $str =~ s/\[t\d+\]/[t\\d+]/msg; + $str =~ s/^\# //mg; # ease cut-paste testcase authoring + my $reftxt = $str; # extra return val !! - # escape bracing, etc.. manual \Q (doesn't escape '+') + # 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; - # $str =~ s/(?<!\\)([\[\]\(\)*.\$\@\#\|{}])/\\$1/msg; - - # treat dbstate like nextstate (no in-debugger false reports) - # Note also that there may be 1 level of () nexting, if there's an eval - # Seems easiest to explicitly match the eval, rather than trying to parse - # for full balancing and then substitute .*? - # In which case, we can continue to match for the eval in the rexexp built - # from the golden result. - - $str =~ s!(?:next|db)state - \\\( # opening literal ( (backslash escaped) - [^()]*? # not () - (\\\(eval\ \d+\\\) # maybe /eval \d+/ in () - [^()]*? # which might be followed by something - )? - \\\) # closing literal ) - !'(?:next|db)state\\([^()]*?' . - ($1 && '\\(eval \\d+\\)[^()]*') # Match the eval if present - . '\\)'!msgxe; + + # 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; - if (!$using_open && $tc->{strip_open_hints}) { - $str =~ s[( # capture - \(\?:next\|db\)state # the regexp matching next/db state - .* # all sorts of things follow it - v # The opening v - ) - (?:(:>,<,%,\\{) # hints when open.pm is in force - |(:>,<,%)) # (two variations) - (\ ->(?:-|[0-9a-z]+))? - $ - ] - [$1 . ($2 && ':{') . $4]xegm; # change to the hints without open.pm - } - # 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/FAKE:(\w):\d+/FAKE:$1:\\d+/msg; # parent pad index - $str =~ s/(\d refs?)/\\d+ refs?/msg; # 1 ref, 2+ refs (plural) + $str =~ s/(\d refs?)/\\d refs?/msg; $str =~ s/leavesub \[\d\]/leavesub [\\d]/msg; # for -terse - #$str =~ s/(\s*)\n/\n/msg; # trailing spaces - - croak "whitespace only reftext found for '$want': $tc->{name}" + + 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 # allow -eval, banner at beginning of anchored matches $str = "(-e .*?)?(B::Concise::compile.*?)?\n" . $str - unless $tc->{noanchors} or $tc->{rxnoorder}; + unless $in->{noanchors} or $in->{rxnoorder}; - my $qr = ($tc->{noanchors}) ? qr/$str/ms : qr/^$str$/ms ; + eval "use re 'debug'" if $debug; + my $qr = ($in->{noanchors}) ? qr/$str/ms : qr/^$str$/ms ; + no re 'debug'; - $tc->{rex} = $qr; - $tc->{rexstr} = $str; - $tc; + return ($qr, $reftxt, $str) if wantarray; + return $qr; } -############## -# compare and report -sub mylike { - # reworked mylike to use hash-obj - my $tc = shift; - my $got = $tc->{got}; - my $want = $tc->{rex}; - my $cmnt = $tc->{name}; - my $cross = $tc->{cross}; +sub printhelp { + # crufty - may be still useful + my ($in, $rendering, $rex) = @_; + print "<$rendering>\nVS\n<$rex>\n" if $gOpts{vbasic}; - # bad is anticipated failure - my $bad = ($cross && $tc->{crossfail}) || (!$cross && $tc->{fail}); - - my $ok = $bad ? unlike ($got, $want, $cmnt) : like ($got, $want, $cmnt); - - reduceDiffs ($tc) if not $ok; - - return $ok; + # 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%$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}; } -sub reduceDiffs { - # isolate the real diffs and report them. - # i.e. these kinds of errs: - # 1. missing or extra ops. this skews all following op-sequences - # 2. single op diff, the rest of the chain is unaltered - # in either case, std err report is inadequate; - - my $tc = shift; - my $got = $tc->{got}; - my @got = split(/\n/, $got); - my $want = $tc->{wantstr}; - my @want = split(/\n/, $want); - - # split rexstr into units that should eat leading lines. - my @rexs = map qr/$_/, split (/\n/, $tc->{rexstr}); - - foreach my $rex (@rexs) { - my $exp = shift @want; - my $line = shift @got; - # remove matches, and report - unless ($got =~ s/($rex\n)//msg) { - _diag("got:\t\t'$line'\nwant:\t $rex\n"); - } - } - _diag("remainder:\n$got"); - _diag("these lines not matched:\n$got\n"); -} - -=head1 Global modes - -Unusually, this module also processes @ARGV for command-line arguments -which set global modes. These 'options' change the way the tests run, -essentially reusing the tests for different purposes. - - - -Additionally, there's an experimental control-arg interface (i.e. -subject to change) which allows the user to set global modes. - -=head1 Testing Method - -At 1st, optreeCheck used one reference-text, but the differences -between Threaded and Non-threaded renderings meant that a single -reference (sampled from say, threaded) would be tricky and iterative -to convert for testing on a non-threaded build. Worse, this conflicts -with making tests both strict and precise. - -We now use 2 reference texts, the right one is used based upon the -build's threaded-ness. This has several benefits: - - 1. native reference data allows closer/easier 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 accommodate 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 -cross-test manipulations. This area needs more work. - -=head1 Test Modes - -One consequence of a single-function API is difficulty controlling -test-mode. I've chosen for now to use a package hash, %gOpts, to store -test-state. These properties alter checkOptree() function, either -short-circuiting to selftest, or running a loop that runs the testcase -2^N times, varying conditions each time. (current N is 2 only). - -So Test-mode is controlled with cmdline args, also called options below. -Run with 'help' to see the test-state, and how to change it. - -=head2 selftest - -This argument invokes runSelftest(), which tests a regex against the -reference renderings that they're made from. Failure of a regex match -its 'mold' is a strong indicator that mkCheckRex is buggy. - -That said, selftest mode currently runs a cross-test too, they're not -completely orthogonal yet. See below. - -=head2 testmode=cross - -Cross-testing is purposely creating a T-NT mismatch, looking at the -fallout, which helps to understand the T-NT differences. - -The tweaking appears contrary to the 2-refs philosophy, but the tweaks -will be made in conversion-specific code, which (will) handles T->NT -and NT->T separately. The tweaking is incomplete. - -A reasonable 1st step is to add tags to indicate when TonNT or NTonT -is known to fail. This needs an option to force failure, so the -test.pl reporting mechanics show results to aid the user. - -=head2 testmode=native - -This is normal mode. Other valid values are: native, cross, both. - -=head2 checkOptree Notes - -Accepts test code, renders its optree using B::Concise, and matches -that rendering against a regex built from one of 2 reference -renderings %tc data. - -The regex is built by mkCheckRex(\%tc), which scrubs %tc data to -remove match-irrelevancies, such as (args) and [args]. For example, -it strips leading '# ', making it easy to cut-paste new tests into -your test-file, run it, and cut-paste actual results into place. You -then retest and reedit until all 'errors' are gone. (now make sure you -haven't 'enshrined' a bug). - -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. - -=cut - -sub runSelftest { - # tests the regex produced by mkCheckRex() - # by using on the expect* text it was created with - # failures indicate a code bug, - # OR regexs plugged into the expect* text (which defeat conversions) - my $tc = shift; - - for my $provenance (qw/ expect expect_nt /) { - #next unless $tc->{$provenance}; - - $tc->mkCheckRex($provenance); - $tc->{got} = $tc->{wantstr}; # fake the rendering - $tc->mylike(); - } -} - -my $dumploaded = 0; - -sub mydumper { - - do { Dumper(@_); return } if $dumploaded; - - eval "require Data::Dumper" - or do{ - print "Sorry, Data::Dumper is not available\n"; - print "half hearted attempt:\n"; - foreach my $it (@_) { - if (ref $it eq 'HASH') { - print " $_ => $it->{$_}\n" foreach sort keys %$it; - } - } - return; - }; - - Data::Dumper->import; - $Data::Dumper::Sortkeys = 1; - $dumploaded++; - Dumper(@_); -} - -############################ +######################### # support for test writing sub preamble { @@ -951,10 +643,8 @@ checkOptree(note => q{$comment}, code => q{$code}, expect => <<EOT_EOT, expect_nt => <<EONT_EONT); ThreadedRef - paste your 'golden-example' here, then retest EOT_EOT -NonThreadedRef - paste your 'golden-example' here, then retest +NonThreadRef EONT_EONT }; @@ -975,17 +665,24 @@ sub OptreeCheck::gentest { # extract the 'reftext' ie the got 'block' if ($got =~ m/got \'.*?\n(.*)\n\# \'\n\# expected/s) { - my $goldentxt = $1; + my $reftext = $1; #and plug it into the test-src if ($threaded) { - $testcode =~ s/ThreadedRef/$goldentxt/; + $testcode =~ s/ThreadedRef/$reftext/; } else { - $testcode =~ s/NonThreadRef/$goldentxt/; + $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 ''; @@ -994,16 +691,14 @@ sub OptreeCheck::gentest { sub OptreeCheck::processExamples { my @files = @_; - - # gets array of paragraphs, which should be code-samples. They're - # turned into optreeCheck tests, + # gets array of paragraphs, which should be tests. foreach my $file (@files) { open (my $fh, $file) or die "cant open $file: $!\n"; $/ = ""; my @chunks = <$fh>; print preamble (scalar @chunks); - foreach my $t (@chunks) { + foreach $t (@chunks) { print "\n\n=for gentest\n\n# chunk: $t=cut\n\n"; print OptreeCheck::gentest ($t); } @@ -1043,8 +738,7 @@ 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. Add <=for gentest> blocks if you care to, or just look at - f_map and f_sort in ext/B/t/ for examples. + paragraph. f_map and f_sort in ext/B/t/ are examples. 2. run OptreeCheck as a program on the file @@ -1061,6 +755,19 @@ according to the following model: the gots into the expects, easier than running step 2 on both builds then trying to sdiff them together. +=head1 TODO + +There's a considerable amount of cruft in the whole arg-handling setup. +I'll replace / strip it before 5.10 + +Treat %in as a test object, interwork better with Test::* + +Refactor mkCheckRex() and selfTest() to isolate the selftest, +crosstest, etc selection mechanics. + +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. + =head1 CAVEATS This code is purely for testing core. While checkOptree feels flexible diff --git a/gnu/usr.bin/perl/ext/B/t/f_map.t b/gnu/usr.bin/perl/ext/B/t/f_map.t index a7a9c268805..ff22dde8e3c 100755 --- a/gnu/usr.bin/perl/ext/B/t/f_map.t +++ b/gnu/usr.bin/perl/ext/B/t/f_map.t @@ -1,7 +1,8 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir q(t); + @INC = qw(../lib ../ext/B/t); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; @@ -11,22 +12,15 @@ BEGIN { print "1..0 # Skip -- need perlio to walk the optree\n"; exit 0; } + if ($] < 5.009) { + print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n"; + exit 0; + } + require q(./test.pl); } use OptreeCheck; -plan tests => 18; - - -=head1 f_map.t - -Code test snippets here are adapted from `perldoc -f map` +plan tests => 9; -Due to a bleadperl optimization (Dave Mitchell, circa may 04), the -(map|grep)(start|while) opcodes have different flags in 5.9, their -private flags /1, /2 are gone in blead (for the cases covered) - -When the optree stuff was integrated into 5.8.6, these tests failed, -and were todo'd. They're now done, by version-specific tweaking in -mkCheckRex(), therefore the skip is removed too. =for gentest @@ -90,53 +84,53 @@ checkOptree(note => q{}, bcopts => q{-exec}, code => q{%hash = map { getkey($_) => $_ } @array; }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 476 (eval 10):1) v:{ +# 1 <;> nextstate(main 476 (eval 10):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t8] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> enter l -# 9 <;> nextstate(main 475 (eval 10):1) v:{ +# 9 <;> nextstate(main 475 (eval 10):1) v # a <0> pushmark s -# b <#> gvsv[*_] s -# c <#> gv[*getkey] s/EARLYCV -# d <1> entersub[t5] lKS/TARG -# e <#> gvsv[*_] s -# f <@> leave lKP +# b <0> pushmark s +# c <#> gvsv[*_] s +# d <#> gv[*getkey] s/EARLYCV +# e <1> entersub[t5] lKS/TARG,1 +# f <#> gvsv[*_] s +# g <@> list lK +# h <@> leave lKP # goto 7 -# g <0> pushmark s -# h <#> gv[*hash] s -# i <1> rv2hv[t2] lKRM*/1 < 5.019006 -# i <1> rv2hv lKRM*/1 >=5.019006 -# j <2> aassign[t10] KS/COMMON -# k <1> leavesub[1 ref] K/REFC,1 +# i <0> pushmark s +# j <#> gv[*hash] s +# k <1> rv2hv[t2] lKRM*/1 +# l <2> aassign[t10] KS/COMMON +# m <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 560 (eval 15):1) v:{ +# 1 <;> nextstate(main 560 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t3] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t4] lK # 8 <0> enter l -# 9 <;> nextstate(main 559 (eval 15):1) v:{ +# 9 <;> nextstate(main 559 (eval 15):1) v # a <0> pushmark s -# b <$> gvsv(*_) s -# c <$> gv(*getkey) s/EARLYCV -# d <1> entersub[t2] lKS/TARG -# e <$> gvsv(*_) s -# f <@> leave lKP +# b <0> pushmark s +# c <$> gvsv(*_) s +# d <$> gv(*getkey) s/EARLYCV +# e <1> entersub[t2] lKS/TARG,1 +# f <$> gvsv(*_) s +# g <@> list lK +# h <@> leave lKP # goto 7 -# g <0> pushmark s -# h <$> gv(*hash) s -# i <1> rv2hv[t1] lKRM*/1 < 5.019006 -# i <1> rv2hv lKRM*/1 >=5.019006 -# j <2> aassign[t5] KS/COMMON -# k <1> leavesub[1 ref] K/REFC,1 +# i <0> pushmark s +# j <$> gv(*hash) s +# k <1> rv2hv[t1] lKRM*/1 +# l <2> aassign[t5] KS/COMMON +# m <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -155,71 +149,69 @@ checkOptree(note => q{}, bcopts => q{-exec}, code => q{{ %hash = (); foreach $_ (@array) { $hash{getkey($_)} = $_; } } }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 478 (eval 10):1) v:{ +# 1 <;> nextstate(main 478 (eval 10):1) v # 2 <{> enterloop(next->u last->u redo->3) # 3 <;> nextstate(main 475 (eval 10):1) v # 4 <0> pushmark s # 5 <0> pushmark s # 6 <#> gv[*hash] s -# 7 <1> rv2hv[t2] lKRM*/1 < 5.019006 -# 7 <1> rv2hv lKRM*/1 >=5.019006 +# 7 <1> rv2hv[t2] lKRM*/1 # 8 <2> aassign[t3] vKS -# 9 <;> nextstate(main 476 (eval 10):1) v:{ +# 9 <;> nextstate(main 476 (eval 10):1) v # a <0> pushmark sM # b <#> gv[*array] s # c <1> rv2av[t6] sKRM/1 # d <#> gv[*_] s # e <1> rv2gv sKRM/1 -# f <{> enteriter(next->q last->t redo->g) lKS/8 +# f <{> enteriter(next->q last->t redo->g) lKS # r <0> iter s # s <|> and(other->g) K/1 -# g <;> nextstate(main 475 (eval 10):1) v:{ +# g <;> nextstate(main 475 (eval 10):1) v # h <#> gvsv[*_] s # i <#> gv[*hash] s # j <1> rv2hv sKR/1 # k <0> pushmark s # l <#> gvsv[*_] s # m <#> gv[*getkey] s/EARLYCV -# n <1> entersub[t10] sKS/TARG +# n <1> entersub[t10] sKS/TARG,1 # o <2> helem sKRM*/2 # p <2> sassign vKS/2 # q <0> unstack s # goto r -# t <2> leaveloop KP/2 +# t <2> leaveloop K/2 # u <2> leaveloop K/2 # v <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 562 (eval 15):1) v:{ +# 1 <;> nextstate(main 562 (eval 15):1) v # 2 <{> enterloop(next->u last->u redo->3) # 3 <;> nextstate(main 559 (eval 15):1) v # 4 <0> pushmark s # 5 <0> pushmark s # 6 <$> gv(*hash) s -# 7 <1> rv2hv[t1] lKRM*/1 < 5.019006 -# 7 <1> rv2hv lKRM*/1 >=5.019006 +# 7 <1> rv2hv[t1] lKRM*/1 # 8 <2> aassign[t2] vKS -# 9 <;> nextstate(main 560 (eval 15):1) v:{ +# 9 <;> nextstate(main 560 (eval 15):1) v # a <0> pushmark sM # b <$> gv(*array) s # c <1> rv2av[t3] sKRM/1 # d <$> gv(*_) s # e <1> rv2gv sKRM/1 -# f <{> enteriter(next->q last->t redo->g) lKS/8 +# f <{> enteriter(next->q last->t redo->g) lKS # r <0> iter s # s <|> and(other->g) K/1 -# g <;> nextstate(main 559 (eval 15):1) v:{ +# g <;> nextstate(main 559 (eval 15):1) v # h <$> gvsv(*_) s # i <$> gv(*hash) s # j <1> rv2hv sKR/1 # k <0> pushmark s # l <$> gvsv(*_) s # m <$> gv(*getkey) s/EARLYCV -# n <1> entersub[t4] sKS/TARG +# n <1> entersub[t4] sKS/TARG,1 # o <2> helem sKRM*/2 # p <2> sassign vKS/2 # q <0> unstack s # goto r -# t <2> leaveloop KP/2 +# t <2> leaveloop K/2 # u <2> leaveloop K/2 # v <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -241,8 +233,7 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t7] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> pushmark s # 9 <#> gvsv[*_] s @@ -250,12 +241,11 @@ checkOptree(note => q{}, # b <@> stringify[t5] sK/1 # c <$> const[IV 1] s # d <@> list lK -# - <@> scope lK < 5.017002 +# - <@> scope lK # goto 7 # e <0> pushmark s # f <#> gv[*hash] s -# g <1> rv2hv[t2] lKRM*/1 < 5.019006 -# g <1> rv2hv lKRM*/1 >=5.019006 +# g <1> rv2hv[t2] lKRM*/1 # h <2> aassign[t10] KS/COMMON # i <1> leavesub[1 ref] K/REFC,1 EOT_EOT @@ -264,8 +254,7 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t4] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t5] lK # 8 <0> pushmark s # 9 <$> gvsv(*_) s @@ -273,12 +262,11 @@ EOT_EOT # b <@> stringify[t3] sK/1 # c <$> const(IV 1) s # d <@> list lK -# - <@> scope lK < 5.017002 +# - <@> scope lK # goto 7 # e <0> pushmark s # f <$> gv(*hash) s -# g <1> rv2hv[t1] lKRM*/1 < 5.019006 -# g <1> rv2hv lKRM*/1 >=5.019006 +# g <1> rv2hv[t1] lKRM*/1 # h <2> aassign[t6] KS/COMMON # i <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -299,8 +287,7 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t7] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> pushmark s # 9 <#> gvsv[*_] s @@ -308,12 +295,11 @@ checkOptree(note => q{}, # b <@> stringify[t5] sK/1 # c <$> const[IV 1] s # d <@> list lKP -# - <@> scope lK < 5.017002 +# - <@> scope lK # goto 7 # e <0> pushmark s # f <#> gv[*hash] s -# g <1> rv2hv[t2] lKRM*/1 < 5.019006 -# g <1> rv2hv lKRM*/1 >=5.019006 +# g <1> rv2hv[t2] lKRM*/1 # h <2> aassign[t10] KS/COMMON # i <1> leavesub[1 ref] K/REFC,1 EOT_EOT @@ -322,8 +308,7 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t4] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t5] lK # 8 <0> pushmark s # 9 <$> gvsv(*_) s @@ -331,12 +316,11 @@ EOT_EOT # b <@> stringify[t3] sK/1 # c <$> const(IV 1) s # d <@> list lKP -# - <@> scope lK < 5.017002 +# - <@> scope lK # goto 7 # e <0> pushmark s # f <$> gv(*hash) s -# g <1> rv2hv[t1] lKRM*/1 < 5.019006 -# g <1> rv2hv lKRM*/1 >=5.019006 +# g <1> rv2hv[t1] lKRM*/1 # h <2> aassign[t6] KS/COMMON # i <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -357,20 +341,18 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t6] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t8] lK # 8 <0> pushmark s # 9 <#> gvsv[*_] s # a <1> lc[t4] sK/1 # b <$> const[IV 1] s # c <@> list lK -# - <@> scope lK < 5.017002 +# - <@> scope lK # goto 7 # d <0> pushmark s # e <#> gv[*hash] s -# f <1> rv2hv[t2] lKRM*/1 < 5.019006 -# f <1> rv2hv lKRM*/1 >=5.019006 +# f <1> rv2hv[t2] lKRM*/1 # g <2> aassign[t9] KS/COMMON # h <1> leavesub[1 ref] K/REFC,1 EOT_EOT @@ -379,20 +361,18 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t3] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t4] lK # 8 <0> pushmark s # 9 <$> gvsv(*_) s # a <1> lc[t2] sK/1 # b <$> const(IV 1) s # c <@> list lK -# - <@> scope lK < 5.017002 +# - <@> scope lK # goto 7 # d <0> pushmark s # e <$> gv(*hash) s -# f <1> rv2hv[t1] lKRM*/1 < 5.019006 -# f <1> rv2hv lKRM*/1 >=5.019006 +# f <1> rv2hv[t1] lKRM*/1 # g <2> aassign[t5] KS/COMMON # h <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -423,8 +403,7 @@ checkOptree(note => q{}, # goto 7 # d <0> pushmark s # e <#> gv[*hash] s -# f <1> rv2hv[t2] lKRM*/1 < 5.019006 -# f <1> rv2hv lKRM*/1 >=5.019006 +# f <1> rv2hv[t2] lKRM*/1 # g <2> aassign[t8] KS/COMMON # h <1> leavesub[1 ref] K/REFC,1 EOT_EOT @@ -443,8 +422,7 @@ EOT_EOT # goto 7 # d <0> pushmark s # e <$> gv(*hash) s -# f <1> rv2hv[t1] lKRM*/1 < 5.019006 -# f <1> rv2hv lKRM*/1 >=5.019006 +# f <1> rv2hv[t1] lKRM*/1 # g <2> aassign[t5] KS/COMMON # h <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -472,8 +450,7 @@ checkOptree(note => q{}, # goto 7 # a <0> pushmark s # b <#> gv[*hash] s -# c <1> rv2hv[t2] lKRM*/1 < 5.019006 -# c <1> rv2hv lKRM*/1 >=5.019006 +# c <1> rv2hv[t2] lKRM*/1 # d <2> aassign[t6] KS/COMMON # e <#> gv[*array] s # f <1> rv2av[t8] K/1 @@ -492,8 +469,7 @@ EOT_EOT # goto 7 # a <0> pushmark s # b <$> gv(*hash) s -# c <1> rv2hv[t1] lKRM*/1 < 5.019006 -# c <1> rv2hv lKRM*/1 >=5.019006 +# c <1> rv2hv[t1] lKRM*/1 # d <2> aassign[t4] KS/COMMON # e <$> gv(*array) s # f <1> rv2av[t5] K/1 @@ -523,13 +499,14 @@ checkOptree(note => q{}, # 9 <#> gvsv[*_] s # a <1> lc[t4] sK/1 # b <$> const[IV 1] s -# c <@> anonhash sK*/1 +# c <@> anonhash sKRM/1 +# d <1> srefgen sK/1 # goto 7 -# d <0> pushmark s -# e <#> gv[*hashes] s -# f <1> rv2av[t2] lKRM*/1 -# g <2> aassign[t8] KS/COMMON -# h <1> leavesub[1 ref] K/REFC,1 +# e <0> pushmark s +# f <#> gv[*hashes] s +# g <1> rv2av[t2] lKRM*/1 +# h <2> aassign[t8] KS/COMMON +# i <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 601 (eval 32):1) v # 2 <0> pushmark s @@ -542,11 +519,12 @@ EOT_EOT # 9 <$> gvsv(*_) s # a <1> lc[t2] sK/1 # b <$> const(IV 1) s -# c <@> anonhash sK*/1 +# c <@> anonhash sKRM/1 +# d <1> srefgen sK/1 # goto 7 -# d <0> pushmark s -# e <$> gv(*hashes) s -# f <1> rv2av[t1] lKRM*/1 -# g <2> aassign[t5] KS/COMMON -# h <1> leavesub[1 ref] K/REFC,1 +# e <0> pushmark s +# f <$> gv(*hashes) s +# g <1> rv2av[t1] lKRM*/1 +# h <2> aassign[t5] KS/COMMON +# i <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/gnu/usr.bin/perl/ext/B/t/f_sort.t b/gnu/usr.bin/perl/ext/B/t/f_sort.t index 65503ca4c30..26dfbe4c54e 100755 --- a/gnu/usr.bin/perl/ext/B/t/f_sort.t +++ b/gnu/usr.bin/perl/ext/B/t/f_sort.t @@ -1,7 +1,8 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir q(t); + @INC = qw(../lib ../ext/B/t); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; @@ -11,21 +12,15 @@ BEGIN { print "1..0 # Skip -- need perlio to walk the optree\n"; exit 0; } + if ($] < 5.009) { + print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n"; + exit 0; + } + require q(./test.pl); } use OptreeCheck; -plan tests => 40; - -=head1 f_sort.t +plan tests => 20; -Code test snippets here are adapted from `perldoc -f map` - -Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the -(map|grep)(start|while) opcodes have different flags in 5.9, their -private flags /1, /2 are gone in blead (for the cases covered) - -When the optree stuff was integrated into 5.8.6, these tests failed, -and were todo'd. They're now done, by version-specific tweaking in -mkCheckRex(), therefore the skip is removed too. =head1 Test Notes @@ -60,7 +55,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t5] KS/COMMON +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 545 (eval 15):1) v @@ -72,7 +67,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -97,7 +92,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -109,7 +104,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -129,26 +124,24 @@ checkOptree(note => q{}, # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*files] s -# 5 <1> rv2av[t9] lK/1 < 5.019002 -# 5 <1> rv2av[t9] lKM/1 >=5.019002 +# 5 <1> rv2av[t9] lK/1 # 6 <@> sort lKS* # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t10] KS/COMMON +# a <2> aassign[t10] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*files) s -# 5 <1> rv2av[t5] lK/1 < 5.019002 -# 5 <1> rv2av[t5] lKM/1 >=5.019002 +# 5 <1> rv2av[t5] lK/1 # 6 <@> sort lKS* # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS/COMMON +# a <2> aassign[t6] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -173,7 +166,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -185,7 +178,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -210,7 +203,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -222,7 +215,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -247,7 +240,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -259,7 +252,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -280,30 +273,26 @@ checkOptree(note => q{}, # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*age] s -# 5 <1> rv2hv[t9] lKRM/1 < 5.019006 -# 5 <1> rv2hv lKRM/1 >=5.019006 -# 6 <1> keys[t10] lK/1 < 5.019002 -# 6 <1> keys[t10] lKM/1 >=5.019002 +# 5 <1> rv2hv[t9] lKRM/1 +# 6 <1> keys[t10] lK/1 # 7 <@> sort lKS* # 8 <0> pushmark s # 9 <#> gv[*eldest] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t11] KS/COMMON +# b <2> aassign[t11] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*age) s -# 5 <1> rv2hv[t3] lKRM/1 < 5.019006 -# 5 <1> rv2hv lKRM/1 >=5.019006 -# 6 <1> keys[t4] lK/1 < 5.019002 -# 6 <1> keys[t4] lKM/1 >=5.019002 +# 5 <1> rv2hv[t3] lKRM/1 +# 6 <1> keys[t4] lK/1 # 7 <@> sort lKS* # 8 <0> pushmark s # 9 <$> gv(*eldest) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -327,13 +316,12 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <$> const[PV "byage"] s/BARE # 5 <#> gv[*class] s -# 6 <1> rv2av[t4] lK/1 < 5.019002 -# 6 <1> rv2av[t4] lKM/1 >=5.019002 +# 6 <1> rv2av[t4] lK/1 # 7 <@> sort lKS # 8 <0> pushmark s # 9 <#> gv[*sortedclass] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -341,13 +329,12 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> const(PV "byage") s/BARE # 5 <$> gv(*class) s -# 6 <1> rv2av[t2] lK/1 < 5.019002 -# 6 <1> rv2av[t2] lKM/1 >=5.019002 +# 6 <1> rv2av[t2] lK/1 # 7 <@> sort lKS # 8 <0> pushmark s # 9 <$> gv(*sortedclass) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS/COMMON +# b <2> aassign[t3] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -396,23 +383,22 @@ checkOptree(name => q{sort USERSUB LIST }, # k <#> gv[*george] s # l <1> rv2av[t5] lKRM*/1 # m <2> aassign[t6] vKS -# n <;> nextstate(main 602 (eval 32):4) v:{ +# n <;> nextstate(main 602 (eval 32):4) v # o <0> pushmark s # p <0> pushmark s # q <#> gv[*harry] s # r <1> rv2av[t8] lK/1 # s <@> sort lK # t <@> print vK -# u <;> nextstate(main 602 (eval 32):4) v:{ +# u <;> nextstate(main 602 (eval 32):4) v # v <0> pushmark s # w <0> pushmark s # x <$> const[PV "backwards"] s/BARE # y <#> gv[*harry] s -# z <1> rv2av[t10] lK/1 < 5.019002 -# z <1> rv2av[t10] lKM/1 >=5.019002 +# z <1> rv2av[t10] lK/1 # 10 <@> sort lKS # 11 <@> print vK -# 12 <;> nextstate(main 602 (eval 32):5) v:{ +# 12 <;> nextstate(main 602 (eval 32):5) v # 13 <0> pushmark s # 14 <0> pushmark s # 15 <#> gv[*george] s @@ -446,23 +432,22 @@ EOT_EOT # k <$> gv(*george) s # l <1> rv2av[t3] lKRM*/1 # m <2> aassign[t4] vKS -# n <;> nextstate(main 602 (eval 32):4) v:{ +# n <;> nextstate(main 602 (eval 32):4) v # o <0> pushmark s # p <0> pushmark s # q <$> gv(*harry) s # r <1> rv2av[t5] lK/1 # s <@> sort lK # t <@> print vK -# u <;> nextstate(main 602 (eval 32):4) v:{ +# u <;> nextstate(main 602 (eval 32):4) v # v <0> pushmark s # w <0> pushmark s # x <$> const(PV "backwards") s/BARE # y <$> gv(*harry) s -# z <1> rv2av[t6] lK/1 < 5.019002 -# z <1> rv2av[t6] lKM/1 >=5.019002 +# z <1> rv2av[t6] lK/1 # 10 <@> sort lKS # 11 <@> print vK -# 12 <;> nextstate(main 602 (eval 32):5) v:{ +# 12 <;> nextstate(main 602 (eval 32):5) v # 13 <0> pushmark s # 14 <0> pushmark s # 15 <$> gv(*george) s @@ -503,81 +488,77 @@ checkOptree(name => q{Compound sort/map Expression }, sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] } map { [$_, /=(\d+)/, uc($_)] } @old; }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 609 (eval 34):3) v:{ +# 1 <;> nextstate(main 609 (eval 34):3) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <0> pushmark s # 5 <0> pushmark s # 6 <#> gv[*old] s # 7 <1> rv2av[t19] lKM/1 -# 8 <@> mapstart lK* < 5.017002 -# 8 <@> mapstart lK >=5.017002 -# 9 <|> mapwhile(other->a)[t20] lK < 5.019002 -# 9 <|> mapwhile(other->a)[t20] lKM >=5.019002 +# 8 <@> mapstart lK* +# 9 <|> mapwhile(other->a)[t20] lK # a <0> enter l -# b <;> nextstate(main 608 (eval 34):2) v:{ +# b <;> nextstate(main 608 (eval 34):2) v # c <0> pushmark s # d <#> gvsv[*_] s # e </> match(/"=(\\d+)"/) l/RTIME # f <#> gvsv[*_] s # g <1> uc[t17] sK/1 -# h <@> anonlist sK*/1 -# i <@> leave lKP +# h <@> anonlist sKRM/1 +# i <1> srefgen sK/1 +# j <@> leave lKP # goto 9 -# j <@> sort lKMS* -# k <@> mapstart lK* < 5.017002 -# k <@> mapstart lK >=5.017002 -# l <|> mapwhile(other->m)[t26] lK -# m <#> gv[*_] s -# n <1> rv2sv sKM/DREFAV,1 -# o <1> rv2av[t4] sKR/1 -# p <$> const[IV 0] s -# q <2> aelem sK/2 -# - <@> scope lK < 5.017002 -# goto l -# r <0> pushmark s -# s <#> gv[*new] s -# t <1> rv2av[t2] lKRM*/1 -# u <2> aassign[t27] KS/COMMON -# v <1> leavesub[1 ref] K/REFC,1 +# k <@> sort lKMS* +# l <@> mapstart lK* +# m <|> mapwhile(other->n)[t26] lK +# n <#> gv[*_] s +# o <1> rv2sv sKM/DREFAV,1 +# p <1> rv2av[t4] sKR/1 +# q <$> const[IV 0] s +# r <2> aelem sK/2 +# - <@> scope lK +# goto m +# s <0> pushmark s +# t <#> gv[*new] s +# u <1> rv2av[t2] lKRM*/1 +# v <2> aassign[t27] KS/COMMON +# w <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 609 (eval 34):3) v:{ +# 1 <;> nextstate(main 609 (eval 34):3) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <0> pushmark s # 5 <0> pushmark s # 6 <$> gv(*old) s # 7 <1> rv2av[t10] lKM/1 -# 8 <@> mapstart lK* < 5.017002 -# 8 <@> mapstart lK >=5.017002 -# 9 <|> mapwhile(other->a)[t11] lK < 5.019002 -# 9 <|> mapwhile(other->a)[t11] lKM >=5.019002 +# 8 <@> mapstart lK* +# 9 <|> mapwhile(other->a)[t11] lK # a <0> enter l -# b <;> nextstate(main 608 (eval 34):2) v:{ +# b <;> nextstate(main 608 (eval 34):2) v # c <0> pushmark s # d <$> gvsv(*_) s # e </> match(/"=(\\d+)"/) l/RTIME # f <$> gvsv(*_) s # g <1> uc[t9] sK/1 -# h <@> anonlist sK*/1 -# i <@> leave lKP +# h <@> anonlist sKRM/1 +# i <1> srefgen sK/1 +# j <@> leave lKP # goto 9 -# j <@> sort lKMS* -# k <@> mapstart lK* < 5.017002 -# k <@> mapstart lK >=5.017002 -# l <|> mapwhile(other->m)[t12] lK -# m <$> gv(*_) s -# n <1> rv2sv sKM/DREFAV,1 -# o <1> rv2av[t2] sKR/1 -# p <$> const(IV 0) s -# q <2> aelem sK/2 -# - <@> scope lK < 5.017002 -# goto l -# r <0> pushmark s -# s <$> gv(*new) s -# t <1> rv2av[t1] lKRM*/1 -# u <2> aassign[t13] KS/COMMON -# v <1> leavesub[1 ref] K/REFC,1 +# k <@> sort lKMS* +# l <@> mapstart lK* +# m <|> mapwhile(other->n)[t12] lK +# n <$> gv(*_) s +# o <1> rv2sv sKM/DREFAV,1 +# p <1> rv2av[t2] sKR/1 +# q <$> const(IV 0) s +# r <2> aelem sK/2 +# - <@> scope lK +# goto m +# s <0> pushmark s +# t <$> gv(*new) s +# u <1> rv2av[t1] lKRM*/1 +# v <2> aassign[t13] KS/COMMON +# w <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -597,32 +578,30 @@ checkOptree(name => q{sort other::sub LIST }, code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; } package main; @new = sort other::backwards @old; }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 614 (eval 36):2) v:{ +# 1 <;> nextstate(main 614 (eval 36):2) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> const[PV "other::backwards"] s/BARE # 5 <#> gv[*old] s -# 6 <1> rv2av[t4] lK/1 < 5.019002 -# 6 <1> rv2av[t4] lKM/1 >=5.019002 +# 6 <1> rv2av[t4] lK/1 # 7 <@> sort lKS # 8 <0> pushmark s # 9 <#> gv[*new] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 614 (eval 36):2) v:{ +# 1 <;> nextstate(main 614 (eval 36):2) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> const(PV "other::backwards") s/BARE # 5 <$> gv(*old) s -# 6 <1> rv2av[t2] lK/1 < 5.019002 -# 6 <1> rv2av[t2] lKM/1 >=5.019002 +# 6 <1> rv2av[t2] lK/1 # 7 <@> sort lKS # 8 <0> pushmark s # 9 <$> gv(*new) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS/COMMON +# b <2> aassign[t3] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -644,13 +623,12 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <$> const[PV "other::backwards"] s/BARE # 5 <#> gv[*old] s -# 6 <1> rv2av[t4] lK/1 < 5.019002 -# 6 <1> rv2av[t4] lKM/1 >=5.019002 +# 6 <1> rv2av[t4] lK/1 # 7 <@> sort lKS # 8 <0> pushmark s # 9 <#> gv[*new] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -658,13 +636,12 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> const(PV "other::backwards") s/BARE # 5 <$> gv(*old) s -# 6 <1> rv2av[t2] lK/1 < 5.019002 -# 6 <1> rv2av[t2] lKM/1 >=5.019002 +# 6 <1> rv2av[t2] lK/1 # 7 <@> sort lKS # 8 <0> pushmark s # 9 <$> gv(*new) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS/COMMON +# b <2> aassign[t3] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -677,39 +654,35 @@ use sort 'stable'; =cut -my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); -# 1 <;> nextstate(main 656 (eval 40):1) v:%,{ +checkOptree(note => q{}, + bcopts => q{-exec}, + code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; }, + expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +# 1 <;> nextstate(main 656 (eval 40):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*old] s -# 5 <1> rv2av[t9] lK/1 < 5.019002 -# 5 <1> rv2av[t9] lKM/1 >=5.019002 -# 6 <@> sort lKS*/STABLE +# 5 <1> rv2av[t9] lK/1 +# 6 <@> sort lKS* # 7 <0> pushmark s # 8 <#> gv[*new] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t14] KS/COMMON +# a <2> aassign[t14] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 578 (eval 15):1) v:%,{ +# 1 <;> nextstate(main 578 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*old) s -# 5 <1> rv2av[t5] lK/1 < 5.019002 -# 5 <1> rv2av[t5] lKM/1 >=5.019002 -# 6 <@> sort lKS*/STABLE +# 5 <1> rv2av[t5] lK/1 +# 6 <@> sort lKS* # 7 <0> pushmark s # 8 <$> gv(*new) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS/COMMON +# a <2> aassign[t6] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT - - -checkOptree(note => q{}, - bcopts => q{-exec}, - code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; }, - expect => $expect, expect_nt => $expect_nt); + =for gentest @@ -723,30 +696,28 @@ checkOptree(note => q{}, bcopts => q{-exec}, code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 662 (eval 42):1) v:%,{ +# 1 <;> nextstate(main 662 (eval 42):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*old] s -# 5 <1> rv2av[t9] lK/1 < 5.019002 -# 5 <1> rv2av[t9] lKM/1 >=5.019002 +# 5 <1> rv2av[t9] lK/1 # 6 <@> sort lKS* # 7 <0> pushmark s # 8 <#> gv[*new] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t14] KS/COMMON +# a <2> aassign[t14] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 578 (eval 15):1) v:%,{ +# 1 <;> nextstate(main 578 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*old) s -# 5 <1> rv2av[t5] lK/1 < 5.019002 -# 5 <1> rv2av[t5] lKM/1 >=5.019002 +# 5 <1> rv2av[t5] lK/1 # 6 <@> sort lKS* # 7 <0> pushmark s # 8 <$> gv(*new) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS/COMMON +# a <2> aassign[t6] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -766,26 +737,24 @@ checkOptree(note => q{}, # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*files] s -# 5 <1> rv2av[t7] lK/1 < 5.019002 -# 5 <1> rv2av[t7] lKM/1 >=5.019002 +# 5 <1> rv2av[t7] lK/1 # 6 <@> sort lKS* # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t8] KS/COMMON +# a <2> aassign[t8] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*files) s -# 5 <1> rv2av[t3] lK/1 < 5.019002 -# 5 <1> rv2av[t3] lKM/1 >=5.019002 +# 5 <1> rv2av[t3] lK/1 # 6 <@> sort lKS* # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t4] KS/COMMON +# a <2> aassign[t4] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -807,19 +776,18 @@ checkOptree(note => q{}, # 4 <0> pushmark s # 5 <#> gv[*input] s # 6 <1> rv2av[t9] lKM/1 -# 7 <@> grepstart lK* < 5.017002 -# 7 <@> grepstart lK >=5.017002 +# 7 <@> grepstart lK* # 8 <|> grepwhile(other->9)[t10] lK # 9 <#> gvsv[*_] s # a <#> gvsv[*_] s # b <2> eq sK/2 -# - <@> scope sK < 5.017002 +# - <@> scope sK # goto 8 # c <@> sort lK/NUM # d <0> pushmark s # e <#> gv[*result] s # f <1> rv2av[t2] lKRM*/1 -# g <2> aassign[t3] KS/COMMON +# g <2> aassign[t5] KS/COMMON # h <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 547 (eval 15):1) v @@ -828,13 +796,12 @@ EOT_EOT # 4 <0> pushmark s # 5 <$> gv(*input) s # 6 <1> rv2av[t3] lKM/1 -# 7 <@> grepstart lK* < 5.017002 -# 7 <@> grepstart lK >=5.017002 +# 7 <@> grepstart lK* # 8 <|> grepwhile(other->9)[t4] lK # 9 <$> gvsv(*_) s # a <$> gvsv(*_) s # b <2> eq sK/2 -# - <@> scope sK < 5.017002 +# - <@> scope sK # goto 8 # c <@> sort lK/NUM # d <0> pushmark s @@ -888,13 +855,12 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*input] s # 5 <1> rv2av[t7] lKM/1 -# 6 <@> grepstart lK* < 5.017002 -# 6 <@> grepstart lK >=5.017002 +# 6 <@> grepstart lK* # 7 <|> grepwhile(other->8)[t8] lK # 8 <#> gvsv[*_] s # 9 <#> gvsv[*_] s # a <2> eq sK/2 -# - <@> scope sK < 5.017002 +# - <@> scope sK # goto 7 # b <@> sort K/NUM # c <1> leavesub[1 ref] K/REFC,1 @@ -904,13 +870,12 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*input) s # 5 <1> rv2av[t2] lKM/1 -# 6 <@> grepstart lK* < 5.017002 -# 6 <@> grepstart lK >=5.017002 +# 6 <@> grepstart lK* # 7 <|> grepwhile(other->8)[t3] lK # 8 <$> gvsv(*_) s # 9 <$> gvsv(*_) s # a <2> eq sK/2 -# - <@> scope sK < 5.017002 +# - <@> scope sK # goto 7 # b <@> sort K/NUM # c <1> leavesub[1 ref] K/REFC,1 @@ -928,7 +893,7 @@ checkOptree(note => q{}, bcopts => q{-exec}, code => q{$s = sort { $a <=> $b } @input; }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 689 (eval 52):1) v:{ +# 1 <;> nextstate(main 689 (eval 52):1) v # 2 <0> pushmark s # 3 <#> gv[*input] s # 4 <1> rv2av[t6] lK/1 @@ -937,7 +902,7 @@ checkOptree(note => q{}, # 7 <2> sassign sKS/2 # 8 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 546 (eval 15):1) v:{ +# 1 <;> nextstate(main 546 (eval 15):1) v # 2 <0> pushmark s # 3 <$> gv(*input) s # 4 <1> rv2av[t2] lK/1 @@ -958,36 +923,34 @@ checkOptree(note => q{}, bcopts => q{-exec}, code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; }, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 695 (eval 54):1) v:{ +# 1 <;> nextstate(main 695 (eval 54):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*input] s # 5 <1> rv2av[t8] lKM/1 -# 6 <@> grepstart lK* < 5.017002 -# 6 <@> grepstart lK >=5.017002 +# 6 <@> grepstart lK* # 7 <|> grepwhile(other->8)[t9] lK # 8 <#> gvsv[*_] s # 9 <#> gvsv[*_] s # a <2> eq sK/2 -# - <@> scope sK < 5.017002 +# - <@> scope sK # goto 7 # b <@> sort sK/NUM # c <#> gvsv[*s] s # d <2> sassign sKS/2 # e <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 547 (eval 15):1) v:{ +# 1 <;> nextstate(main 547 (eval 15):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*input) s # 5 <1> rv2av[t2] lKM/1 -# 6 <@> grepstart lK* < 5.017002 -# 6 <@> grepstart lK >=5.017002 +# 6 <@> grepstart lK* # 7 <|> grepwhile(other->8)[t3] lK # 8 <$> gvsv(*_) s # 9 <$> gvsv(*_) s # a <2> eq sK/2 -# - <@> scope sK < 5.017002 +# - <@> scope sK # goto 7 # b <@> sort sK/NUM # c <$> gvsv(*s) s diff --git a/gnu/usr.bin/perl/ext/B/t/optree_check.t b/gnu/usr.bin/perl/ext/B/t/optree_check.t index 38ff88b64e9..2e2ef9cf3db 100755 --- a/gnu/usr.bin/perl/ext/B/t/optree_check.t +++ b/gnu/usr.bin/perl/ext/B/t/optree_check.t @@ -1,16 +1,14 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir 't'; + @INC = ('../lib', '../ext/B/t'); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; exit 0; } - if (!$Config::Config{useperlio}) { - print "1..0 # Skip -- need perlio to walk the optree\n"; - exit 0; - } + require './test.pl'; } use OptreeCheck; @@ -26,12 +24,13 @@ cmdline args in 'standard' way across all clients of OptreeCheck. =cut -plan tests => 11 # REGEX TEST HARNESS SELFTEST - + 3 # TEST FATAL ERRS - + 11 # TEST -e \$srcCode - + 5 # REFTEXT FIXUP TESTS - + 5 # CANONICAL B::Concise EXAMPLE - + 16 * $gOpts{selftest}; # XXX I don't understand this - DAPM +use Config; +plan tests => 5 + 18 + 14 * $gOpts{selftest}; # fudged + +SKIP: { + skip "no perlio in this build", 5 + 18 + 14 * $gOpts{selftest} + unless $Config::Config{useperlio}; + pass("REGEX TEST HARNESS SELFTEST"); @@ -50,7 +49,7 @@ checkOptree ( name => "found print opcode", expect_nt => 'leavesub'); checkOptree ( name => 'test skip itself', - skip => 'this is skip-reason', + skip => 1, bcopts => '-exec', code => sub {print 1}, expect => 'dont-care, skipping', @@ -60,17 +59,18 @@ checkOptree ( name => 'test skip itself', # no good way to expect a successful todo, and inducing a failure # causes the harness to print verbose errors, which is NOT helpful. -checkOptree ( name => 'test todo itself', - todo => "your excuse here ;-)", +checkOptree ( name => 'test todo itself. suppressed, remove skip to test', + todo => "suppress todo test for now", + skip => 1, bcopts => '-exec', code => sub {print 1}, noanchors => 1, # unanchored match expect => 'print', - expect_nt => 'print') if 0; + expect_nt => 'print'); checkOptree ( name => 'impossible match, remove skip to see failure', todo => "see! it breaks!", - skip => 'skip the failure', + skip => 1, # but skip it 1st code => sub {print 1}, expect => 'look out ! Boy Wonder', expect_nt => 'holy near earth asteroid Batman !'); @@ -80,7 +80,16 @@ pass ("TEST FATAL ERRS"); if (1) { # test for fatal errors. Im unsettled on fail vs die. # calling fail isnt good enough by itself. - + eval { + + checkOptree ( name => 'empty code or prog', + todo => "your excuse here ;-)", + code => '', + prog => '', + ); + }; + like($@, 'code or prog is required', 'empty code or prog prevented'); + $@=''; eval { checkOptree ( name => 'test against empty expectations', @@ -89,7 +98,7 @@ if (1) { expect => '', expect_nt => ''); }; - like($@, qr/no '\w+' golden-sample found/, "empty expectations prevented"); + like($@, 'no reftext found for', "empty expectations prevented"); $@=''; eval { @@ -100,37 +109,31 @@ if (1) { expect_nt => "\n", expect => "\n"); }; - like($@, qr/whitespace only reftext found for '\w+'/, - "just whitespace expectations prevented"); + like($@, 'no reftext found for', "just whitespace expectations prevented"); } - + pass ("TEST -e \$srcCode"); -checkOptree ( name => 'empty code or prog', - skip => 'or fails', - todo => "your excuse here ;-)", - code => '', - prog => '', - ); +checkOptree + ( name => '-w errors seen', + prog => 'sort our @a', + errs => 'Useless use of sort in void context at -e line 1.', + ); checkOptree ( name => "self strict, catch err", prog => 'use strict; bogus', errs => 'Bareword "bogus" not allowed while "strict subs" in use at -e line 1.', - expect => "nextstate", # simple expectations - expect_nt => "nextstate", - noanchors => 1, # allow them to work ); -checkOptree ( name => "sort lK - flag specific search", - prog => 'our (@a,@b); @b = sort @a', +checkOptree ( name => "sort vK - flag specific search", + prog => 'sort our @a', noanchors => 1, - expect => '<@> sort lK ', - expect_nt => '<@> sort lK '); + expect => '<@> sort vK ', + expect_nt => '<@> sort vK '); -checkOptree ( name => "sort vK - flag specific search", +checkOptree ( name => "'prog' => 'sort our \@a'", prog => 'sort our @a', - errs => 'Useless use of sort in void context at -e line 1.', noanchors => 1, expect => '<@> sort vK', expect_nt => '<@> sort vK'); @@ -146,13 +149,12 @@ pass ("REFTEXT FIXUP TESTS"); checkOptree ( name => 'fixup nextstate (in reftext)', bcopts => '-exec', code => sub {my $a}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate( NOTE THAT THIS CAN BE ANYTHING ) v:>,<,% +# 1 <;> nextstate( NOTE THAT THIS CAN BE ANYTHING ) v # 2 <0> padsv[$a:54,55] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 54 optree_concise.t:84) v:>,<,% +# 1 <;> nextstate(main 54 optree_concise.t:84) v # 2 <0> padsv[$a:54,55] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -161,13 +163,12 @@ checkOptree ( name => 'fixup opcode args', bcopts => '-exec', #fail => 1, # uncomment to see real padsv args: [$a:491,492] code => sub {my $a}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 56 optree_concise.t:96) v:>,<,% +# 1 <;> nextstate(main 56 optree_concise.t:96) v # 2 <0> padsv[$a:56,57] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 56 optree_concise.t:96) v:>,<,% +# 1 <;> nextstate(main 56 optree_concise.t:96) v # 2 <0> padsv[$a:56,57] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -179,11 +180,11 @@ checkOptree ( name => 'canonical example w -basic', bcopts => '-basic', code => sub{$a=$b+42}, crossfail => 1, - strip_open_hints => 1, + debug => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 7 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->7 -# 1 <;> nextstate(main 380 optree_selftest.t:139) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 380 optree_selftest.t:139) v ->2 # 6 <2> sassign sKS/2 ->7 # 4 <2> add[t3] sK/2 ->5 # - <1> ex-rv2sv sK/1 ->3 @@ -194,7 +195,7 @@ checkOptree ( name => 'canonical example w -basic', EOT_EOT # 7 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->7 -# 1 <;> nextstate(main 60 optree_concise.t:122) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 60 optree_concise.t:122) v ->2 # 6 <2> sassign sKS/2 ->7 # 4 <2> add[t1] sK/2 ->5 # - <1> ex-rv2sv sK/1 ->3 @@ -204,10 +205,15 @@ EOT_EOT # 5 <$> gvsv(*a) s ->6 EONT_EONT -checkOptree ( code => '$a=$b+42', +checkOptree ( name => 'canonical example w -exec', bcopts => '-exec', + code => sub{$a=$b+42}, + crossfail => 1, + retry => 1, + debug => 1, + xtestfail => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 837 (eval 24):1) v:{ +# 1 <;> nextstate(main 61 optree_concise.t:139) v # 2 <#> gvsv[*b] s # 3 <$> const[IV 42] s # 4 <2> add[t3] sK/2 @@ -215,7 +221,7 @@ checkOptree ( code => '$a=$b+42', # 6 <2> sassign sKS/2 # 7 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 837 (eval 24):1) v:{ +# 1 <;> nextstate(main 61 optree_concise.t:139) v # 2 <$> gvsv(*b) s # 3 <$> const(IV 42) s # 4 <2> add[t1] sK/2 @@ -223,3 +229,11 @@ EOT_EOT # 6 <2> sassign sKS/2 # 7 <1> leavesub[1 ref] K/REFC,1 EONT_EONT + +checkOptree ( name => 'tree reftext is messy cut-paste', + skip => 1); + +} # skip + +__END__ + diff --git a/gnu/usr.bin/perl/ext/B/t/optree_concise.t b/gnu/usr.bin/perl/ext/B/t/optree_concise.t index aa28ebb14ca..97140c1d0d0 100755 --- a/gnu/usr.bin/perl/ext/B/t/optree_concise.t +++ b/gnu/usr.bin/perl/ext/B/t/optree_concise.t @@ -1,23 +1,23 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir 't'; + @INC = ('../lib', '../ext/B/t'); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; exit 0; } - if (!$Config::Config{useperlio}) { - print "1..0 # Skip -- need perlio to walk the optree\n"; - exit 0; - } + require './test.pl'; } # import checkOptree(), and %gOpts (containing test state) use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!! use Config; -plan tests => 41; +plan tests => 24; +SKIP: { +skip "no perlio in this build", 24 unless $Config::Config{useperlio}; $SIG{__WARN__} = sub { my $err = shift; @@ -29,13 +29,12 @@ pass("CANONICAL B::Concise EXAMPLE"); checkOptree ( name => 'canonical example w -basic', bcopts => '-basic', code => sub{$a=$b+42}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 7 <1> leavesub[1 ref] K/REFC,1 ->(end) +# 7 <1> leavesub[\d+ refs?] K/REFC,1 ->(end) # - <@> lineseq KP ->7 -# 1 <;> nextstate(foo bar) v:>,<,%,{ ->2 +# 1 <;> nextstate(foo bar) v ->2 # 6 <2> sassign sKS/2 ->7 -# 4 <2> add[t3] sK/2 ->5 +# 4 <2> add[t\d+] sK/2 ->5 # - <1> ex-rv2sv sK/1 ->3 # 2 <#> gvsv[*b] s ->3 # 3 <$> const[IV 42] s ->4 @@ -44,7 +43,7 @@ checkOptree ( name => 'canonical example w -basic', EOT_EOT # 7 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->7 -# 1 <;> nextstate(main 60 optree_concise.t:122) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 60 optree_concise.t:122) v ->2 # 6 <2> sassign sKS/2 ->7 # 4 <2> add[t1] sK/2 ->5 # - <1> ex-rv2sv sK/1 ->3 @@ -57,9 +56,8 @@ EONT_EONT checkOptree ( name => 'canonical example w -exec', bcopts => '-exec', code => sub{$a=$b+42}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 61 optree_concise.t:139) v:>,<,%,{ +# 1 <;> nextstate(main 61 optree_concise.t:139) v # 2 <#> gvsv[*b] s # 3 <$> const[IV 42] s # 4 <2> add[t3] sK/2 @@ -67,7 +65,7 @@ checkOptree ( name => 'canonical example w -exec', # 6 <2> sassign sKS/2 # 7 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 61 optree_concise.t:139) v:>,<,%,{ +# 1 <;> nextstate(main 61 optree_concise.t:139) v # 2 <$> gvsv(*b) s # 3 <$> const(IV 42) s # 4 <2> add[t1] sK/2 @@ -82,9 +80,8 @@ pass("B::Concise OPTION TESTS"); checkOptree ( name => '-base3 sticky-exec', bcopts => '-base3', code => sub{$a=$b+42}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> dbstate(main 24 optree_concise.t:132) v:>,<,%,{ +1 <;> dbstate(main 24 optree_concise.t:132) v 2 <#> gvsv[*b] s 10 <$> const[IV 42] s 11 <2> add[t3] sK/2 @@ -92,7 +89,7 @@ checkOptree ( name => '-base3 sticky-exec', 20 <2> sassign sKS/2 21 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 62 optree_concise.t:161) v:>,<,%,{ +# 1 <;> nextstate(main 62 optree_concise.t:161) v # 2 <$> gvsv(*b) s # 10 <$> const(IV 42) s # 11 <2> add[t1] sK/2 @@ -104,11 +101,10 @@ EONT_EONT checkOptree ( name => 'sticky-base3, -basic over sticky-exec', bcopts => '-basic', code => sub{$a=$b+42}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 21 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->21 -1 <;> nextstate(main 32 optree_concise.t:164) v:>,<,%,{ ->2 +1 <;> nextstate(main 32 optree_concise.t:164) v ->2 20 <2> sassign sKS/2 ->21 11 <2> add[t3] sK/2 ->12 - <1> ex-rv2sv sK/1 ->10 @@ -119,7 +115,7 @@ checkOptree ( name => 'sticky-base3, -basic over sticky-exec', EOT_EOT # 21 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->21 -# 1 <;> nextstate(main 63 optree_concise.t:186) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 63 optree_concise.t:186) v ->2 # 20 <2> sassign sKS/2 ->21 # 11 <2> add[t1] sK/2 ->12 # - <1> ex-rv2sv sK/1 ->10 @@ -132,11 +128,10 @@ EONT_EONT checkOptree ( name => '-base4', bcopts => [qw/ -basic -base4 /], code => sub{$a=$b+42}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 13 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->13 -1 <;> nextstate(main 26 optree_concise.t:145) v:>,<,%,{ ->2 +1 <;> nextstate(main 26 optree_concise.t:145) v ->2 12 <2> sassign sKS/2 ->13 10 <2> add[t3] sK/2 ->11 - <1> ex-rv2sv sK/1 ->3 @@ -147,7 +142,7 @@ checkOptree ( name => '-base4', EOT_EOT # 13 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->13 -# 1 <;> nextstate(main 64 optree_concise.t:193) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 64 optree_concise.t:193) v ->2 # 12 <2> sassign sKS/2 ->13 # 10 <2> add[t1] sK/2 ->11 # - <1> ex-rv2sv sK/1 ->3 @@ -161,17 +156,16 @@ checkOptree ( name => "restore -base36 default", bcopts => [qw/ -basic -base36 /], code => sub{$a}, crossfail => 1, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 3 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->3 -1 <;> nextstate(main 27 optree_concise.t:161) v:>,<,% ->2 +1 <;> nextstate(main 27 optree_concise.t:161) v ->2 - <1> ex-rv2sv sK/1 ->- 2 <#> gvsv[*a] s ->3 EOT_EOT # 3 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->3 -# 1 <;> nextstate(main 65 optree_concise.t:210) v:>,<,% ->2 +# 1 <;> nextstate(main 65 optree_concise.t:210) v ->2 # - <1> ex-rv2sv sK/1 ->- # 2 <$> gvsv(*a) s ->3 EONT_EONT @@ -208,17 +202,13 @@ EONT_EONT pass("OPTIONS IN CMDLINE MODE"); -checkOptree ( name => 'cmdline invoke -basic works', - prog => 'sort @a', - errs => [ 'Useless use of sort in void context at -e line 1.', - 'Name "main::a" used only once: possible typo at -e line 1.', - ], +checkOptree ( name => 'cmdline invoke -basic works', + prog => 'sort @a', #bcopts => '-basic', # default - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 7 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # 6 <@> sort vK ->7 # 3 <0> pushmark s ->4 # 5 <1> rv2av[t2] lK/1 ->6 @@ -226,23 +216,19 @@ checkOptree ( name => 'cmdline invoke -basic works', EOT_EOT # 7 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # 6 <@> sort vK ->7 # 3 <0> pushmark s ->4 # 5 <1> rv2av[t1] lK/1 ->6 # 4 <$> gv(*a) s ->5 EONT_EONT -checkOptree ( name => 'cmdline invoke -exec works', - prog => 'sort @a', - errs => [ 'Useless use of sort in void context at -e line 1.', - 'Name "main::a" used only once: possible typo at -e line 1.', - ], - bcopts => '-exec', - strip_open_hints => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +checkOptree ( name => 'cmdline invoke -exec works', + prog => 'sort @a', + bcopts => '-exec', + expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> pushmark s 4 <#> gv[*a] s 5 <1> rv2av[t2] lK/1 @@ -250,7 +236,7 @@ checkOptree ( name => 'cmdline invoke -exec works', 7 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> pushmark s # 4 <$> gv(*a) s # 5 <1> rv2av[t1] lK/1 @@ -259,40 +245,39 @@ EOT_EOT EONT_EONT ; - +$DB::single=1; checkOptree ( name => 'cmdline self-strict compile err using prog', prog => 'use strict; sort @a', bcopts => [qw/ -basic -concise -exec /], - errs => 'Global symbol "@a" requires explicit package name at -e line 1.', - expect => 'nextstate', - expect_nt => 'nextstate', - noanchors => 1, # allow simple expectations to work + errs => 'Global symbol "@a" requires explicit package name at .*? line 1.', ); checkOptree ( name => 'cmdline self-strict compile err using code', code => 'use strict; sort @a', bcopts => [qw/ -basic -concise -exec /], - errs => qr/Global symbol "\@a" requires explicit package name at .*? line 1\./, - note => 'this test relys on a kludge which copies $@ to rendering when empty', - expect => 'Global symbol', - expect_nt => 'Global symbol', - noanchors => 1, # allow simple expectations to work + #noanchors => 1, + errs => 'Global symbol "@a" requires explicit package name at .*? line 1.', + ); + +checkOptree + ( name => 'useless use of sort in void context', + prog => 'our @a; sort @a', + bcopts => [qw/ -basic -concise -exec /], + errs => 'Useless use of sort in void context at -e line 1.', ); checkOptree ( name => 'cmdline -basic -concise -exec works', prog => 'our @a; sort @a', bcopts => [qw/ -basic -concise -exec /], - errs => ['Useless use of sort in void context at -e line 1.'], - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <#> gv[*a] s # 4 <1> rv2av[t3] vK/OURINTR,1 -# 5 <;> nextstate(main 2 -e:1) v:>,<,%,{ +# 5 <;> nextstate(main 2 -e:1) v # 6 <0> pushmark s # 7 <#> gv[*a] s # 8 <1> rv2av[t5] lK/1 @@ -300,10 +285,10 @@ checkOptree # a <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <$> gv(*a) s # 4 <1> rv2av[t2] vK/OURINTR,1 -# 5 <;> nextstate(main 2 -e:1) v:>,<,%,{ +# 5 <;> nextstate(main 2 -e:1) v # 6 <0> pushmark s # 7 <$> gv(*a) s # 8 <1> rv2av[t3] lK/1 @@ -353,7 +338,7 @@ sub set_up_relative_test { $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub'; } elsif ($style eq 'scope') { - # suppress printout entirely + # supress printout entirely $$format="" unless grep { $h->{name} eq $_ } @scopeops; } }); @@ -366,9 +351,8 @@ pass("set_up_relative_test, new callback installed"); checkOptree ( name => 'callback used, independent of style', bcopts => [qw/ -concise -exec /], code => sub{$a=$b+42}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main 76 optree_concise.t:337) v:>,<,%,{ +1 <;> nextstate(main 76 optree_concise.t:337) v 2 <#> gvsv[*b] s 3 <$> const[IV 42] CALLBACK s 4 <2> add[t3] sK/2 @@ -376,7 +360,7 @@ checkOptree ( name => 'callback used, independent of style', 6 <2> sassign sKS/2 7 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 455 optree_concise.t:328) v:>,<,%,{ +# 1 <;> nextstate(main 455 optree_concise.t:328) v # 2 <$> gvsv(*b) s # 3 <$> const(IV 42) CALLBACK s # 4 <2> add[t1] sK/2 @@ -469,3 +453,6 @@ EOT_EOT 7 <1> leavesub[1 ref] K/REFC,1 ->(end) 1 <;> nextstate(main 76 optree_concise.t:407) v ->2 EONT_EONT + +} #skip + diff --git a/gnu/usr.bin/perl/ext/B/t/optree_samples.t b/gnu/usr.bin/perl/ext/B/t/optree_samples.t index 2a9c0105427..c51eeaeb353 100755 --- a/gnu/usr.bin/perl/ext/B/t/optree_samples.t +++ b/gnu/usr.bin/perl/ext/B/t/optree_samples.t @@ -1,20 +1,24 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir 't'; + @INC = ('../lib', '../ext/B/t'); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; exit 0; } - if (!$Config::Config{useperlio}) { - print "1..0 # Skip -- need perlio to walk the optree\n"; + if ($] < 5.009) { + print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n"; exit 0; } + require './test.pl'; } use OptreeCheck; use Config; -plan tests => 46; +plan tests => 20; +SKIP: { + skip "no perlio in this build", 20 unless $Config::Config{useperlio}; pass("GENERAL OPTREE EXAMPLES"); @@ -25,43 +29,46 @@ checkOptree ( name => '-basic sub {if shift print then,else}', code => sub { if (shift) { print "then" } else { print "else" } }, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 7 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->7 -# 1 <;> nextstate(main 665 optree_samples.t:24) v:>,<,% ->2 +# 9 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->9 +# 1 <;> nextstate(main 426 optree.t:16) v ->2 # - <1> null K/1 ->- -# 3 <|> cond_expr(other->4) K/1 ->8 -# 2 <0> shift s* ->3 +# 5 <|> cond_expr(other->6) K/1 ->a +# 4 <1> shift sK/1 ->5 +# 3 <1> rv2av[t2] sKRM/1 ->4 +# 2 <#> gv[*_] s ->3 # - <@> scope K ->- -# - <0> ex-nextstate v ->4 -# 6 <@> print sK ->7 -# 4 <0> pushmark s ->5 -# 5 <$> const[PV "then"] s ->6 -# d <@> leave KP ->7 -# 8 <0> enter ->9 -# 9 <;> nextstate(main 663 optree_samples.t:25) v:>,<,% ->a -# c <@> print sK ->d -# a <0> pushmark s ->b -# b <$> const[PV "else"] s ->c +# - <0> ex-nextstate v ->6 +# 8 <@> print sK ->9 +# 6 <0> pushmark s ->7 +# 7 <$> const[PV "then"] s ->8 +# f <@> leave KP ->9 +# a <0> enter ->b +# b <;> nextstate(main 424 optree.t:17) v ->c +# e <@> print sK ->f +# c <0> pushmark s ->d +# d <$> const[PV "else"] s ->e EOT_EOT -# 7 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->7 -# 1 <;> nextstate(main 665 optree_samples.t:24) v:>,<,% ->2 +# 9 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->9 +# 1 <;> nextstate(main 427 optree_samples.t:18) v ->2 # - <1> null K/1 ->- -# 3 <|> cond_expr(other->4) K/1 ->8 -# 2 <0> shift s* ->3 +# 5 <|> cond_expr(other->6) K/1 ->a +# 4 <1> shift sK/1 ->5 +# 3 <1> rv2av[t1] sKRM/1 ->4 +# 2 <$> gv(*_) s ->3 # - <@> scope K ->- -# - <0> ex-nextstate v ->4 -# 6 <@> print sK ->7 -# 4 <0> pushmark s ->5 -# 5 <$> const(PV "then") s ->6 -# d <@> leave KP ->7 -# 8 <0> enter ->9 -# 9 <;> nextstate(main 663 optree_samples.t:25) v:>,<,% ->a -# c <@> print sK ->d -# a <0> pushmark s ->b -# b <$> const(PV "else") s ->c +# - <0> ex-nextstate v ->6 +# 8 <@> print sK ->9 +# 6 <0> pushmark s ->7 +# 7 <$> const(PV "then") s ->8 +# f <@> leave KP ->9 +# a <0> enter ->b +# b <;> nextstate(main 425 optree_samples.t:19) v ->c +# e <@> print sK ->f +# c <0> pushmark s ->d +# d <$> const(PV "else") s ->e EONT_EONT checkOptree ( name => '-basic (see above, with my $a = shift)', @@ -70,51 +77,54 @@ checkOptree ( name => '-basic (see above, with my $a = shift)', if ($a) { print "foo" } else { print "bar" } }, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# b <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->b -# 1 <;> nextstate(main 666 optree_samples.t:70) v:>,<,% ->2 -# 4 <2> sassign vKS/2 ->5 -# 2 <0> shift s* ->3 -# 3 <0> padsv[$a:666,670] sRM*/LVINTRO ->4 -# 5 <;> nextstate(main 670 optree_samples.t:71) v:>,<,% ->6 +# d <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->d +# 1 <;> nextstate(main 431 optree.t:68) v ->2 +# 6 <2> sassign vKS/2 ->7 +# 4 <1> shift sK/1 ->5 +# 3 <1> rv2av[t3] sKRM/1 ->4 +# 2 <#> gv[*_] s ->3 +# 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6 +# 7 <;> nextstate(main 435 optree.t:69) v ->8 # - <1> null K/1 ->- -# 7 <|> cond_expr(other->8) K/1 ->c -# 6 <0> padsv[$a:666,670] s ->7 +# 9 <|> cond_expr(other->a) K/1 ->e +# 8 <0> padsv[$a:431,435] s ->9 # - <@> scope K ->- -# - <0> ex-nextstate v ->8 -# a <@> print sK ->b -# 8 <0> pushmark s ->9 -# 9 <$> const[PV "foo"] s ->a -# h <@> leave KP ->b -# c <0> enter ->d -# d <;> nextstate(main 668 optree_samples.t:72) v:>,<,% ->e -# g <@> print sK ->h -# e <0> pushmark s ->f -# f <$> const[PV "bar"] s ->g +# - <0> ex-nextstate v ->a +# c <@> print sK ->d +# a <0> pushmark s ->b +# b <$> const[PV "foo"] s ->c +# j <@> leave KP ->d +# e <0> enter ->f +# f <;> nextstate(main 433 optree.t:70) v ->g +# i <@> print sK ->j +# g <0> pushmark s ->h +# h <$> const[PV "bar"] s ->i EOT_EOT -# b <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->b -# 1 <;> nextstate(main 666 optree_samples.t:72) v:>,<,% ->2 -# 4 <2> sassign vKS/2 ->5 -# 2 <0> shift s* ->3 -# 3 <0> padsv[$a:666,670] sRM*/LVINTRO ->4 -# 5 <;> nextstate(main 670 optree_samples.t:73) v:>,<,% ->6 +# d <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->d +# 1 <;> nextstate(main 428 optree_samples.t:48) v ->2 +# 6 <2> sassign vKS/2 ->7 +# 4 <1> shift sK/1 ->5 +# 3 <1> rv2av[t2] sKRM/1 ->4 +# 2 <$> gv(*_) s ->3 +# 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6 +# 7 <;> nextstate(main 432 optree_samples.t:49) v ->8 # - <1> null K/1 ->- -# 7 <|> cond_expr(other->8) K/1 ->c -# 6 <0> padsv[$a:666,670] s ->7 +# 9 <|> cond_expr(other->a) K/1 ->e +# 8 <0> padsv[$a:428,432] s ->9 # - <@> scope K ->- -# - <0> ex-nextstate v ->8 -# a <@> print sK ->b -# 8 <0> pushmark s ->9 -# 9 <$> const(PV "foo") s ->a -# h <@> leave KP ->b -# c <0> enter ->d -# d <;> nextstate(main 668 optree_samples.t:74) v:>,<,% ->e -# g <@> print sK ->h -# e <0> pushmark s ->f -# f <$> const(PV "bar") s ->g +# - <0> ex-nextstate v ->a +# c <@> print sK ->d +# a <0> pushmark s ->b +# b <$> const(PV "foo") s ->c +# j <@> leave KP ->d +# e <0> enter ->f +# f <;> nextstate(main 430 optree_samples.t:50) v ->g +# i <@> print sK ->j +# g <0> pushmark s ->h +# h <$> const(PV "bar") s ->i EONT_EONT checkOptree ( name => '-exec sub {if shift print then,else}', @@ -122,37 +132,40 @@ checkOptree ( name => '-exec sub {if shift print then,else}', code => sub { if (shift) { print "then" } else { print "else" } }, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 674 optree_samples.t:125) v:>,<,% -# 2 <0> shift s* -# 3 <|> cond_expr(other->4) K/1 -# 4 <0> pushmark s -# 5 <$> const[PV "then"] s -# 6 <@> print sK -# goto 7 -# 8 <0> enter -# 9 <;> nextstate(main 672 optree_samples.t:126) v:>,<,% -# a <0> pushmark s -# b <$> const[PV "else"] s -# c <@> print sK -# d <@> leave KP -# 7 <1> leavesub[1 ref] K/REFC,1 +# 1 <;> nextstate(main 426 optree.t:16) v +# 2 <#> gv[*_] s +# 3 <1> rv2av[t2] sKRM/1 +# 4 <1> shift sK/1 +# 5 <|> cond_expr(other->6) K/1 +# 6 <0> pushmark s +# 7 <$> const[PV "then"] s +# 8 <@> print sK +# goto 9 +# a <0> enter +# b <;> nextstate(main 424 optree.t:17) v +# c <0> pushmark s +# d <$> const[PV "else"] s +# e <@> print sK +# f <@> leave KP +# 9 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 674 optree_samples.t:129) v:>,<,% -# 2 <0> shift s* -# 3 <|> cond_expr(other->4) K/1 -# 4 <0> pushmark s -# 5 <$> const(PV "then") s -# 6 <@> print sK -# goto 7 -# 8 <0> enter -# 9 <;> nextstate(main 672 optree_samples.t:130) v:>,<,% -# a <0> pushmark s -# b <$> const(PV "else") s -# c <@> print sK -# d <@> leave KP -# 7 <1> leavesub[1 ref] K/REFC,1 +# 1 <;> nextstate(main 436 optree_samples.t:123) v +# 2 <$> gv(*_) s +# 3 <1> rv2av[t1] sKRM/1 +# 4 <1> shift sK/1 +# 5 <|> cond_expr(other->6) K/1 +# 6 <0> pushmark s +# 7 <$> const(PV "then") s +# 8 <@> print sK +# goto 9 +# a <0> enter +# b <;> nextstate(main 434 optree_samples.t:124) v +# c <0> pushmark s +# d <$> const(PV "else") s +# e <@> print sK +# f <@> leave KP +# 9 <1> leavesub[1 ref] K/REFC,1 EONT_EONT checkOptree ( name => '-exec (see above, with my $a = shift)', @@ -161,71 +174,77 @@ checkOptree ( name => '-exec (see above, with my $a = shift)', if ($a) { print "foo" } else { print "bar" } }, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 675 optree_samples.t:165) v:>,<,% -# 2 <0> shift s* -# 3 <0> padsv[$a:675,679] sRM*/LVINTRO -# 4 <2> sassign vKS/2 -# 5 <;> nextstate(main 679 optree_samples.t:166) v:>,<,% -# 6 <0> padsv[$a:675,679] s -# 7 <|> cond_expr(other->8) K/1 -# 8 <0> pushmark s -# 9 <$> const[PV "foo"] s -# a <@> print sK -# goto b -# c <0> enter -# d <;> nextstate(main 677 optree_samples.t:167) v:>,<,% -# e <0> pushmark s -# f <$> const[PV "bar"] s -# g <@> print sK -# h <@> leave KP -# b <1> leavesub[1 ref] K/REFC,1 +# 1 <;> nextstate(main 423 optree.t:16) v +# 2 <#> gv[*_] s +# 3 <1> rv2av[t3] sKRM/1 +# 4 <1> shift sK/1 +# 5 <0> padsv[$a:423,427] sRM*/LVINTRO +# 6 <2> sassign vKS/2 +# 7 <;> nextstate(main 427 optree.t:17) v +# 8 <0> padsv[$a:423,427] s +# 9 <|> cond_expr(other->a) K/1 +# a <0> pushmark s +# b <$> const[PV "foo"] s +# c <@> print sK +# goto d +# e <0> enter +# f <;> nextstate(main 425 optree.t:18) v +# g <0> pushmark s +# h <$> const[PV "bar"] s +# i <@> print sK +# j <@> leave KP +# d <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 675 optree_samples.t:171) v:>,<,% -# 2 <0> shift s* -# 3 <0> padsv[$a:675,679] sRM*/LVINTRO -# 4 <2> sassign vKS/2 -# 5 <;> nextstate(main 679 optree_samples.t:172) v:>,<,% -# 6 <0> padsv[$a:675,679] s -# 7 <|> cond_expr(other->8) K/1 -# 8 <0> pushmark s -# 9 <$> const(PV "foo") s -# a <@> print sK -# goto b -# c <0> enter -# d <;> nextstate(main 677 optree_samples.t:173) v:>,<,% -# e <0> pushmark s -# f <$> const(PV "bar") s -# g <@> print sK -# h <@> leave KP -# b <1> leavesub[1 ref] K/REFC,1 +# 1 <;> nextstate(main 437 optree_samples.t:112) v +# 2 <$> gv(*_) s +# 3 <1> rv2av[t2] sKRM/1 +# 4 <1> shift sK/1 +# 5 <0> padsv[$a:437,441] sRM*/LVINTRO +# 6 <2> sassign vKS/2 +# 7 <;> nextstate(main 441 optree_samples.t:113) v +# 8 <0> padsv[$a:437,441] s +# 9 <|> cond_expr(other->a) K/1 +# a <0> pushmark s +# b <$> const(PV "foo") s +# c <@> print sK +# goto d +# e <0> enter +# f <;> nextstate(main 439 optree_samples.t:114) v +# g <0> pushmark s +# h <$> const(PV "bar") s +# i <@> print sK +# j <@> leave KP +# d <1> leavesub[1 ref] K/REFC,1 EONT_EONT checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }', code => sub { print (shift) ? "foo" : "bar" }, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 680 optree_samples.t:213) v:>,<,% +# 1 <;> nextstate(main 428 optree.t:31) v # 2 <0> pushmark s -# 3 <0> shift s* -# 4 <@> print sK -# 5 <|> cond_expr(other->6) K/1 -# 6 <$> const[PV "foo"] s -# goto 7 -# 8 <$> const[PV "bar"] s -# 7 <1> leavesub[1 ref] K/REFC,1 +# 3 <#> gv[*_] s +# 4 <1> rv2av[t2] sKRM/1 +# 5 <1> shift sK/1 +# 6 <@> print sK +# 7 <|> cond_expr(other->8) K/1 +# 8 <$> const[PV "foo"] s +# goto 9 +# a <$> const[PV "bar"] s +# 9 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 680 optree_samples.t:221) v:>,<,% +# 1 <;> nextstate(main 442 optree_samples.t:144) v # 2 <0> pushmark s -# 3 <0> shift s* -# 4 <@> print sK -# 5 <|> cond_expr(other->6) K/1 -# 6 <$> const(PV "foo") s -# goto 7 -# 8 <$> const(PV "bar") s -# 7 <1> leavesub[1 ref] K/REFC,1 +# 3 <$> gv(*_) s +# 4 <1> rv2av[t1] sKRM/1 +# 5 <1> shift sK/1 +# 6 <@> print sK +# 7 <|> cond_expr(other->8) K/1 +# 8 <$> const(PV "foo") s +# goto 9 +# a <$> const(PV "bar") s +# 9 <1> leavesub[1 ref] K/REFC,1 EONT_EONT pass ("FOREACH"); @@ -233,17 +252,16 @@ pass ("FOREACH"); checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }', code => sub { foreach (1..10) {print "foo $_"} }, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 443 optree.t:158) v:>,<,% +# 1 <;> nextstate(main 443 optree.t:158) v # 2 <0> pushmark s # 3 <$> const[IV 1] s # 4 <$> const[IV 10] s # 5 <#> gv[*_] s -# 6 <{> enteriter(next->d last->g redo->7) lKS/8 +# 6 <{> enteriter(next->d last->g redo->7) lKS # e <0> iter s # f <|> and(other->7) K/1 -# 7 <;> nextstate(main 442 optree.t:158) v:>,<,% +# 7 <;> nextstate(main 442 optree.t:158) v # 8 <0> pushmark s # 9 <$> const[PV "foo "] s # a <#> gvsv[*_] s @@ -254,15 +272,15 @@ checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }', # g <2> leaveloop K/2 # h <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 444 optree_samples.t:182) v:>,<,% +# 1 <;> nextstate(main 444 optree_samples.t:182) v # 2 <0> pushmark s # 3 <$> const(IV 1) s # 4 <$> const(IV 10) s # 5 <$> gv(*_) s -# 6 <{> enteriter(next->d last->g redo->7) lKS/8 +# 6 <{> enteriter(next->d last->g redo->7) lKS # e <0> iter s # f <|> and(other->7) K/1 -# 7 <;> nextstate(main 443 optree_samples.t:182) v:>,<,% +# 7 <;> nextstate(main 443 optree_samples.t:182) v # 8 <0> pushmark s # 9 <$> const(PV "foo ") s # a <$> gvsv(*_) s @@ -277,74 +295,74 @@ EONT_EONT checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }', code => sub { print "foo $_" foreach (1..10) }, bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# g <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->g -# 1 <;> nextstate(main 445 optree.t:167) v:>,<,% ->2 -# f <2> leaveloop K/2 ->g -# 6 <{> enteriter(next->c last->f redo->7) lKS/8 ->d -# - <0> ex-pushmark s ->2 -# - <1> ex-list lK ->5 -# 2 <0> pushmark s ->3 -# 3 <$> const[IV 1] s ->4 -# 4 <$> const[IV 10] s ->5 -# 5 <#> gv[*_] s ->6 -# - <1> null K/1 ->f -# e <|> and(other->7) K/1 ->f -# d <0> iter s ->e +# h <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->h +# 1 <;> nextstate(main 445 optree.t:167) v ->2 +# 2 <;> nextstate(main 445 optree.t:167) v ->3 +# g <2> leaveloop K/2 ->h +# 7 <{> enteriter(next->d last->g redo->8) lKS ->e +# - <0> ex-pushmark s ->3 +# - <1> ex-list lK ->6 +# 3 <0> pushmark s ->4 +# 4 <$> const[IV 1] s ->5 +# 5 <$> const[IV 10] s ->6 +# 6 <#> gv[*_] s ->7 +# - <1> null K/1 ->g +# f <|> and(other->8) K/1 ->g +# e <0> iter s ->f # - <@> lineseq sK ->- -# b <@> print vK ->c -# 7 <0> pushmark s ->8 -# - <1> ex-stringify sK/1 ->b -# - <0> ex-pushmark s ->8 -# a <2> concat[t2] sK/2 ->b -# 8 <$> const[PV "foo "] s ->9 -# - <1> ex-rv2sv sK/1 ->a -# 9 <#> gvsv[*_] s ->a -# c <0> unstack s ->d +# c <@> print vK ->d +# 8 <0> pushmark s ->9 +# - <1> ex-stringify sK/1 ->c +# - <0> ex-pushmark s ->9 +# b <2> concat[t2] sK/2 ->c +# 9 <$> const[PV "foo "] s ->a +# - <1> ex-rv2sv sK/1 ->b +# a <#> gvsv[*_] s ->b +# d <0> unstack s ->e EOT_EOT -# g <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->g -# 1 <;> nextstate(main 446 optree_samples.t:192) v:>,<,% ->2 -# f <2> leaveloop K/2 ->g -# 6 <{> enteriter(next->c last->f redo->7) lKS/8 ->d -# - <0> ex-pushmark s ->2 -# - <1> ex-list lK ->5 -# 2 <0> pushmark s ->3 -# 3 <$> const(IV 1) s ->4 -# 4 <$> const(IV 10) s ->5 -# 5 <$> gv(*_) s ->6 -# - <1> null K/1 ->f -# e <|> and(other->7) K/1 ->f -# d <0> iter s ->e +# h <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->h +# 1 <;> nextstate(main 446 optree_samples.t:192) v ->2 +# 2 <;> nextstate(main 446 optree_samples.t:192) v ->3 +# g <2> leaveloop K/2 ->h +# 7 <{> enteriter(next->d last->g redo->8) lKS ->e +# - <0> ex-pushmark s ->3 +# - <1> ex-list lK ->6 +# 3 <0> pushmark s ->4 +# 4 <$> const(IV 1) s ->5 +# 5 <$> const(IV 10) s ->6 +# 6 <$> gv(*_) s ->7 +# - <1> null K/1 ->g +# f <|> and(other->8) K/1 ->g +# e <0> iter s ->f # - <@> lineseq sK ->- -# b <@> print vK ->c -# 7 <0> pushmark s ->8 -# - <1> ex-stringify sK/1 ->b -# - <0> ex-pushmark s ->8 -# a <2> concat[t1] sK/2 ->b -# 8 <$> const(PV "foo ") s ->9 -# - <1> ex-rv2sv sK/1 ->a -# 9 <$> gvsv(*_) s ->a -# c <0> unstack s ->d +# c <@> print vK ->d +# 8 <0> pushmark s ->9 +# - <1> ex-stringify sK/1 ->c +# - <0> ex-pushmark s ->9 +# b <2> concat[t1] sK/2 ->c +# 9 <$> const(PV "foo ") s ->a +# - <1> ex-rv2sv sK/1 ->b +# a <$> gvsv(*_) s ->b +# d <0> unstack s ->e EONT_EONT checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}', prog => 'foreach (1..10) {print qq{foo $_}}', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 1 <0> enter -# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 2 -e:1) v # 3 <0> pushmark s # 4 <$> const[IV 1] s # 5 <$> const[IV 10] s # 6 <#> gv[*_] s -# 7 <{> enteriter(next->e last->h redo->8) lKS/8 +# 7 <{> enteriter(next->e last->h redo->8) lKS # f <0> iter s # g <|> and(other->8) vK/1 -# 8 <;> nextstate(main 1 -e:1) v:>,<,% +# 8 <;> nextstate(main 1 -e:1) v # 9 <0> pushmark s # a <$> const[PV "foo "] s # b <#> gvsv[*_] s @@ -356,15 +374,15 @@ checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}', # i <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 2 -e:1) v # 3 <0> pushmark s # 4 <$> const(IV 1) s # 5 <$> const(IV 10) s # 6 <$> gv(*_) s -# 7 <{> enteriter(next->e last->h redo->8) lKS/8 +# 7 <{> enteriter(next->e last->h redo->8) lKS # f <0> iter s # g <|> and(other->8) vK/1 -# 8 <;> nextstate(main 1 -e:1) v:>,<,% +# 8 <;> nextstate(main 1 -e:1) v # 9 <0> pushmark s # a <$> const(PV "foo ") s # b <$> gvsv(*_) s @@ -379,43 +397,44 @@ EONT_EONT checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }', code => sub { print "foo $_" foreach (1..10) }, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 445 optree.t:167) v:>,<,% -# 2 <0> pushmark s -# 3 <$> const[IV 1] s -# 4 <$> const[IV 10] s -# 5 <#> gv[*_] s -# 6 <{> enteriter(next->c last->f redo->7) lKS/8 -# d <0> iter s -# e <|> and(other->7) K/1 -# 7 <0> pushmark s -# 8 <$> const[PV "foo "] s -# 9 <#> gvsv[*_] s -# a <2> concat[t2] sK/2 -# b <@> print vK -# c <0> unstack s -# goto d -# f <2> leaveloop K/2 -# g <1> leavesub[1 ref] K/REFC,1 +# 1 <;> nextstate(main 445 optree.t:167) v +# 2 <;> nextstate(main 445 optree.t:167) v +# 3 <0> pushmark s +# 4 <$> const[IV 1] s +# 5 <$> const[IV 10] s +# 6 <#> gv[*_] s +# 7 <{> enteriter(next->d last->g redo->8) lKS +# e <0> iter s +# f <|> and(other->8) K/1 +# 8 <0> pushmark s +# 9 <$> const[PV "foo "] s +# a <#> gvsv[*_] s +# b <2> concat[t2] sK/2 +# c <@> print vK +# d <0> unstack s +# goto e +# g <2> leaveloop K/2 +# h <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 447 optree_samples.t:252) v:>,<,% -# 2 <0> pushmark s -# 3 <$> const(IV 1) s -# 4 <$> const(IV 10) s -# 5 <$> gv(*_) s -# 6 <{> enteriter(next->c last->f redo->7) lKS/8 -# d <0> iter s -# e <|> and(other->7) K/1 -# 7 <0> pushmark s -# 8 <$> const(PV "foo ") s -# 9 <$> gvsv(*_) s -# a <2> concat[t1] sK/2 -# b <@> print vK -# c <0> unstack s -# goto d -# f <2> leaveloop K/2 -# g <1> leavesub[1 ref] K/REFC,1 +# 1 <;> nextstate(main 447 optree_samples.t:252) v +# 2 <;> nextstate(main 447 optree_samples.t:252) v +# 3 <0> pushmark s +# 4 <$> const(IV 1) s +# 5 <$> const(IV 10) s +# 6 <$> gv(*_) s +# 7 <{> enteriter(next->d last->g redo->8) lKS +# e <0> iter s +# f <|> and(other->8) K/1 +# 8 <0> pushmark s +# 9 <$> const(PV "foo ") s +# a <$> gvsv(*_) s +# b <2> concat[t1] sK/2 +# c <@> print vK +# d <0> unstack s +# goto e +# g <2> leaveloop K/2 +# h <1> leavesub[1 ref] K/REFC,1 EONT_EONT pass("GREP: SAMPLES FROM PERLDOC -F GREP"); @@ -424,7 +443,7 @@ checkOptree ( name => '@foo = grep(!/^\#/, @bar)', code => '@foo = grep(!/^\#/, @bar)', bcopts => '-exec', expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 496 (eval 20):1) v:{ +# 1 <;> nextstate(main 496 (eval 20):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*bar] s @@ -440,7 +459,7 @@ checkOptree ( name => '@foo = grep(!/^\#/, @bar)', # d <2> aassign[t6] KS/COMMON # e <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 496 (eval 20):1) v:{ +# 1 <;> nextstate(main 496 (eval 20):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*bar) s @@ -464,53 +483,53 @@ checkOptree ( name => '%h = map { getkey($_) => $_ } @a', code => '%h = map { getkey($_) => $_ } @a', bcopts => '-exec', expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 501 (eval 22):1) v:{ +# 1 <;> nextstate(main 501 (eval 22):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*a] s # 5 <1> rv2av[t8] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> enter l -# 9 <;> nextstate(main 500 (eval 22):1) v:{ +# 9 <;> nextstate(main 500 (eval 22):1) v # a <0> pushmark s -# b <#> gvsv[*_] s -# c <#> gv[*getkey] s/EARLYCV -# d <1> entersub[t5] lKS/TARG -# e <#> gvsv[*_] s -# f <@> leave lKP +# b <0> pushmark s +# c <#> gvsv[*_] s +# d <#> gv[*getkey] s/EARLYCV +# e <1> entersub[t5] lKS/TARG,1 +# f <#> gvsv[*_] s +# g <@> list lK +# h <@> leave lKP # goto 7 -# g <0> pushmark s -# h <#> gv[*h] s -# i <1> rv2hv[t2] lKRM*/1 < 5.019006 -# i <1> rv2hv lKRM*/1 >=5.019006 -# j <2> aassign[t10] KS/COMMON -# k <1> leavesub[1 ref] K/REFC,1 +# i <0> pushmark s +# j <#> gv[*h] s +# k <1> rv2hv[t2] lKRM*/1 +# l <2> aassign[t10] KS/COMMON +# m <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 501 (eval 22):1) v:{ +# 1 <;> nextstate(main 501 (eval 22):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*a) s # 5 <1> rv2av[t3] lKM/1 -# 6 <@> mapstart lK* < 5.017002 -# 6 <@> mapstart lK >=5.017002 +# 6 <@> mapstart lK* # 7 <|> mapwhile(other->8)[t4] lK # 8 <0> enter l -# 9 <;> nextstate(main 500 (eval 22):1) v:{ +# 9 <;> nextstate(main 500 (eval 22):1) v # a <0> pushmark s -# b <$> gvsv(*_) s -# c <$> gv(*getkey) s/EARLYCV -# d <1> entersub[t2] lKS/TARG -# e <$> gvsv(*_) s -# f <@> leave lKP +# b <0> pushmark s +# c <$> gvsv(*_) s +# d <$> gv(*getkey) s/EARLYCV +# e <1> entersub[t2] lKS/TARG,1 +# f <$> gvsv(*_) s +# g <@> list lK +# h <@> leave lKP # goto 7 -# g <0> pushmark s -# h <$> gv(*h) s -# i <1> rv2hv[t1] lKRM*/1 < 5.019006 -# i <1> rv2hv lKRM*/1 >=5.019006 -# j <2> aassign[t5] KS/COMMON -# k <1> leavesub[1 ref] K/REFC,1 +# i <0> pushmark s +# j <$> gv(*h) s +# k <1> rv2hv[t1] lKRM*/1 +# l <2> aassign[t5] KS/COMMON +# m <1> leavesub[1 ref] K/REFC,1 EONT_EONT checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}', @@ -521,62 +540,60 @@ checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}', # 2 <0> pushmark s # 3 <0> pushmark s # 4 <#> gv[*h] s -# 5 <1> rv2hv[t2] lKRM*/1 < 5.019006 -# 5 <1> rv2hv lKRM*/1 >=5.019006 +# 5 <1> rv2hv[t2] lKRM*/1 # 6 <2> aassign[t3] vKS -# 7 <;> nextstate(main 506 (eval 24):1) v:{ +# 7 <;> nextstate(main 506 (eval 24):1) v # 8 <0> pushmark sM # 9 <#> gv[*a] s # a <1> rv2av[t6] sKRM/1 # b <#> gv[*_] s # c <1> rv2gv sKRM/1 -# d <{> enteriter(next->o last->r redo->e) lKS/8 +# d <{> enteriter(next->o last->r redo->e) lKS # p <0> iter s # q <|> and(other->e) K/1 -# e <;> nextstate(main 505 (eval 24):1) v:{ +# e <;> nextstate(main 505 (eval 24):1) v # f <#> gvsv[*_] s # g <#> gv[*h] s # h <1> rv2hv sKR/1 # i <0> pushmark s # j <#> gvsv[*_] s # k <#> gv[*getkey] s/EARLYCV -# l <1> entersub[t10] sKS/TARG +# l <1> entersub[t10] sKS/TARG,1 # m <2> helem sKRM*/2 # n <2> sassign vKS/2 # o <0> unstack s # goto p -# r <2> leaveloop KP/2 +# r <2> leaveloop K/2 # s <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 505 (eval 24):1) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*h) s -# 5 <1> rv2hv[t1] lKRM*/1 < 5.019006 -# 5 <1> rv2hv lKRM*/1 >=5.019006 +# 5 <1> rv2hv[t1] lKRM*/1 # 6 <2> aassign[t2] vKS -# 7 <;> nextstate(main 506 (eval 24):1) v:{ +# 7 <;> nextstate(main 506 (eval 24):1) v # 8 <0> pushmark sM # 9 <$> gv(*a) s # a <1> rv2av[t3] sKRM/1 # b <$> gv(*_) s # c <1> rv2gv sKRM/1 -# d <{> enteriter(next->o last->r redo->e) lKS/8 +# d <{> enteriter(next->o last->r redo->e) lKS # p <0> iter s # q <|> and(other->e) K/1 -# e <;> nextstate(main 505 (eval 24):1) v:{ +# e <;> nextstate(main 505 (eval 24):1) v # f <$> gvsv(*_) s # g <$> gv(*h) s # h <1> rv2hv sKR/1 # i <0> pushmark s # j <$> gvsv(*_) s # k <$> gv(*getkey) s/EARLYCV -# l <1> entersub[t4] sKS/TARG +# l <1> entersub[t4] sKS/TARG,1 # m <2> helem sKRM*/2 # n <2> sassign vKS/2 # o <0> unstack s # goto p -# r <2> leaveloop KP/2 +# r <2> leaveloop K/2 # s <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -589,7 +606,7 @@ checkOptree ( name => 'map $_+42, 10..20', # 3 <$> const[AV ] s # 4 <1> rv2av lKPM/1 # 5 <@> mapstart K -# 6 <|> mapwhile(other->7)[t5] K +# 6 <|> mapwhile(other->7)[t7] K # 7 <#> gvsv[*_] s # 8 <$> const[IV 42] s # 9 <2> add[t2] sK/2 @@ -614,113 +631,23 @@ pass("CONSTANTS"); checkOptree ( name => '-e use constant j => qq{junk}; print j', prog => 'use constant j => qq{junk}; print j', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 1 <0> enter -# 2 <;> nextstate(main 71 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 71 -e:1) v # 3 <0> pushmark s -# 4 <$> const[PV "junk"] s* < 5.017002 -# 4 <$> const[PV "junk"] s*/FOLD >=5.017002 +# 4 <$> const[PV "junk"] s # 5 <@> print vK # 6 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 71 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 71 -e:1) v # 3 <0> pushmark s -# 4 <$> const(PV "junk") s* < 5.017002 -# 4 <$> const(PV "junk") s*/FOLD >=5.017002 +# 4 <$> const(PV "junk") s # 5 <@> print vK # 6 <@> leave[1 ref] vKP/REFC EONT_EONT -pass("rpeep - return \$x at end of sub"); - -checkOptree ( name => '-exec sub { return 1 }', - code => sub { return 1 }, - bcopts => '-exec', - strip_open_hints => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 1 -e:1) v:>,<,% -# 2 <$> const[IV 1] s -# 3 <1> leavesub[1 ref] K/REFC,1 -EOT_EOT -# 1 <;> nextstate(main 1 -e:1) v:>,<,% -# 2 <$> const(IV 1) s -# 3 <1> leavesub[1 ref] K/REFC,1 -EONT_EONT - -pass("rpeep - if ($a || $b)"); - -checkOptree ( name => 'if ($a || $b) { } return 1', - code => 'if ($a || $b) { } return 1', - bcopts => '-exec', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 997 (eval 15):1) v -# 2 <#> gvsv[*a] s -# 3 <|> or(other->4) sK/1 -# 4 <#> gvsv[*b] s -# 5 <|> and(other->6) vK/1 -# 6 <0> stub v -# 7 <;> nextstate(main 997 (eval 15):1) v -# 8 <$> const[IV 1] s -# 9 <1> leavesub[1 ref] K/REFC,1 -EOT_EOT -# 1 <;> nextstate(main 997 (eval 15):1) v -# 2 <$> gvsv(*a) s -# 3 <|> or(other->4) sK/1 -# 4 <$> gvsv(*b) s -# 5 <|> and(other->6) vK/1 -# 6 <0> stub v -# 7 <;> nextstate(main 3 (eval 3):1) v -# 8 <$> const(IV 1) s -# 9 <1> leavesub[1 ref] K/REFC,1 -EONT_EONT - -pass("rpeep - unless ($a && $b)"); - -checkOptree ( name => 'unless ($a && $b) { } return 1', - code => 'unless ($a && $b) { } return 1', - bcopts => '-exec', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 997 (eval 15):1) v -# 2 <#> gvsv[*a] s -# 3 <|> and(other->4) sK/1 -# 4 <#> gvsv[*b] s -# 5 <|> or(other->6) vK/1 -# 6 <0> stub v -# 7 <;> nextstate(main 997 (eval 15):1) v -# 8 <$> const[IV 1] s -# 9 <1> leavesub[1 ref] K/REFC,1 -EOT_EOT -# 1 <;> nextstate(main 997 (eval 15):1) v -# 2 <$> gvsv(*a) s -# 3 <|> and(other->4) sK/1 -# 4 <$> gvsv(*b) s -# 5 <|> or(other->6) vK/1 -# 6 <0> stub v -# 7 <;> nextstate(main 3 (eval 3):1) v -# 8 <$> const(IV 1) s -# 9 <1> leavesub[1 ref] K/REFC,1 -EONT_EONT - -pass("rpeep - my $a; my @b; my %c; print 'f'"); - -checkOptree ( name => 'my $a; my @b; my %c; return 1', - code => 'my $a; my @b; my %c; return 1', - bcopts => '-exec', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 991 (eval 17):1) v -# 2 <0> padrange[$a:991,994; @b:992,994; %c:993,994] vM/LVINTRO,3 -# 3 <;> nextstate(main 994 (eval 17):1) v:{ -# 4 <$> const[IV 1] s -# 5 <1> leavesub[1 ref] K/REFC,1 -EOT_EOT -# 1 <;> nextstate(main 991 (eval 17):1) v -# 2 <0> padrange[$a:991,994; @b:992,994; %c:993,994] vM/LVINTRO,3 -# 3 <;> nextstate(main 994 (eval 17):1) v:{ -# 4 <$> const(IV 1) s -# 5 <1> leavesub[1 ref] K/REFC,1 -EONT_EONT +} # skip __END__ diff --git a/gnu/usr.bin/perl/ext/B/t/optree_sort.t b/gnu/usr.bin/perl/ext/B/t/optree_sort.t index a78b31ee94a..b7615d941fc 100755 --- a/gnu/usr.bin/perl/ext/B/t/optree_sort.t +++ b/gnu/usr.bin/perl/ext/B/t/optree_sort.t @@ -1,36 +1,36 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir 't'; + @INC = ('../lib', '../ext/B/t'); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; exit 0; } - if (!$Config::Config{useperlio}) { - print "1..0 # Skip -- need perlio to walk the optree\n"; - exit 0; - } + require './test.pl'; } use OptreeCheck; use Config; -plan tests => 21; +plan tests => 11; + +SKIP: { +skip "no perlio in this build", 11 unless $Config::Config{useperlio}; pass("SORT OPTIMIZATION"); checkOptree ( name => 'sub {sort @a}', code => sub {sort @a}, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 424 optree_sort.t:14) v:>,<,% +# 1 <;> nextstate(main 424 optree_sort.t:14) v # 2 <0> pushmark s # 3 <#> gv[*a] s # 4 <1> rv2av[t2] lK/1 # 5 <@> sort K # 6 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 424 optree_sort.t:14) v:>,<,% +# 1 <;> nextstate(main 424 optree_sort.t:14) v # 2 <0> pushmark s # 3 <$> gv(*a) s # 4 <1> rv2av[t1] lK/1 @@ -38,16 +38,12 @@ EOT_EOT # 6 <1> leavesub[1 ref] K/REFC,1 EONT_EONT -checkOptree ( name => 'sort @a', - prog => 'sort @a', - errs => [ 'Useless use of sort in void context at -e line 1.', - 'Name "main::a" used only once: possible typo at -e line 1.', - ], - bcopts => '-exec', - strip_open_hints => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +checkOptree ( name => 'sort @a', + prog => 'sort @a', + bcopts => '-exec', + expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> pushmark s 4 <#> gv[*a] s 5 <1> rv2av[t2] lK/1 @@ -55,7 +51,7 @@ checkOptree ( name => 'sort @a', 7 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> pushmark s # 4 <$> gv(*a) s # 5 <1> rv2av[t1] lK/1 @@ -66,9 +62,8 @@ EONT_EONT checkOptree ( name => 'sub {@a = sort @a}', code => sub {@a = sort @a}, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main -438 optree.t:244) v:>,<,% +1 <;> nextstate(main -438 optree.t:244) v 2 <0> pushmark s 3 <0> pushmark s 4 <#> gv[*a] s @@ -77,10 +72,10 @@ checkOptree ( name => 'sub {@a = sort @a}', 7 <0> pushmark s 8 <#> gv[*a] s 9 <1> rv2av[t2] lKRM*/1 -a <2> aassign[t5] KS/COMMON +a <2> aassign[t\d+] KS/COMMON b <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 65 optree.t:311) v:>,<,% +# 1 <;> nextstate(main 65 optree.t:311) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*a) s @@ -96,10 +91,9 @@ EONT_EONT checkOptree ( name => '@a = sort @a', prog => '@a = sort @a', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> pushmark s 4 <0> pushmark s 5 <#> gv[*a] s @@ -108,7 +102,7 @@ checkOptree ( name => '@a = sort @a', 8 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> pushmark s # 4 <0> pushmark s # 5 <$> gv(*a) s @@ -120,28 +114,27 @@ EONT_EONT checkOptree ( name => 'sub {@a = sort @a; reverse @a}', code => sub {@a = sort @a; reverse @a}, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main -438 optree.t:286) v:>,<,% +1 <;> nextstate(main -438 optree.t:286) v 2 <0> pushmark s 3 <0> pushmark s 4 <#> gv[*a] s 5 <1> rv2av[t4] lKRM*/1 6 <@> sort lK/INPLACE -7 <;> nextstate(main -438 optree.t:288) v:>,<,% +7 <;> nextstate(main -438 optree.t:288) v 8 <0> pushmark s 9 <#> gv[*a] s a <1> rv2av[t7] lK/1 b <@> reverse[t8] K/1 c <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 66 optree.t:345) v:>,<,% +# 1 <;> nextstate(main 66 optree.t:345) v # 2 <0> pushmark s # 3 <0> pushmark s # 4 <$> gv(*a) s # 5 <1> rv2av[t2] lKRM*/1 # 6 <@> sort lK/INPLACE -# 7 <;> nextstate(main 66 optree.t:346) v:>,<,% +# 7 <;> nextstate(main 66 optree.t:346) v # 8 <0> pushmark s # 9 <$> gv(*a) s # a <1> rv2av[t4] lK/1 @@ -151,18 +144,16 @@ EONT_EONT checkOptree ( name => '@a = sort @a; reverse @a', prog => '@a = sort @a; reverse @a', - errs => ['Useless use of reverse in void context at -e line 1.'], bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> pushmark s 4 <0> pushmark s 5 <#> gv[*a] s 6 <1> rv2av[t4] lKRM*/1 7 <@> sort lK/INPLACE -8 <;> nextstate(main 1 -e:1) v:>,<,%,{ +8 <;> nextstate(main 1 -e:1) v 9 <0> pushmark s a <#> gv[*a] s b <1> rv2av[t7] lK/1 @@ -170,13 +161,13 @@ c <@> reverse[t8] vK/1 d <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> pushmark s # 4 <0> pushmark s # 5 <$> gv(*a) s # 6 <1> rv2av[t2] lKRM*/1 # 7 <@> sort lK/INPLACE -# 8 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 8 <;> nextstate(main 1 -e:1) v # 9 <0> pushmark s # a <$> gv(*a) s # b <1> rv2av[t4] lK/1 @@ -187,109 +178,120 @@ EONT_EONT checkOptree ( name => 'sub {my @a; @a = sort @a}', code => sub {my @a; @a = sort @a}, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main -437 optree.t:254) v:>,<,% +1 <;> nextstate(main -437 optree.t:254) v 2 <0> padav[@a:-437,-436] vM/LVINTRO -3 <;> nextstate(main -436 optree.t:256) v:>,<,% +3 <;> nextstate(main -436 optree.t:256) v 4 <0> pushmark s 5 <0> pushmark s 6 <0> padav[@a:-437,-436] l 7 <@> sort lK -8 <0> padrange[@a:-437,-436] l/1 -9 <2> aassign[t2] KS/COMMON -a <1> leavesub[1 ref] K/REFC,1 +8 <0> pushmark s +9 <0> padav[@a:-437,-436] lRM* +a <2> aassign[t\d+] KS/COMMON +b <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 427 optree_sort.t:172) v:>,<,% +# 1 <;> nextstate(main 427 optree_sort.t:172) v # 2 <0> padav[@a:427,428] vM/LVINTRO -# 3 <;> nextstate(main 428 optree_sort.t:173) v:>,<,% +# 3 <;> nextstate(main 428 optree_sort.t:173) v # 4 <0> pushmark s # 5 <0> pushmark s # 6 <0> padav[@a:427,428] l # 7 <@> sort lK -# 8 <0> padrange[@a:427,428] l/1 -# 9 <2> aassign[t2] KS/COMMON -# a <1> leavesub[1 ref] K/REFC,1 +# 8 <0> pushmark s +# 9 <0> padav[@a:427,428] lRM* +# a <2> aassign[t2] KS/COMMON +# b <1> leavesub[1 ref] K/REFC,1 EONT_EONT checkOptree ( name => 'my @a; @a = sort @a', prog => 'my @a; @a = sort @a', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> padav[@a:1,2] vM/LVINTRO -4 <;> nextstate(main 2 -e:1) v:>,<,%,{ +4 <;> nextstate(main 2 -e:1) v 5 <0> pushmark s -6 <0> padrange[@a:1,2] l/1 -7 <@> sort lK/INPLACE -8 <@> leave[1 ref] vKP/REFC +6 <0> pushmark s +7 <0> padav[@a:1,2] lRM* +8 <@> sort lK/INPLACE +9 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> padav[@a:1,2] vM/LVINTRO -# 4 <;> nextstate(main 2 -e:1) v:>,<,%,{ +# 4 <;> nextstate(main 2 -e:1) v # 5 <0> pushmark s -# 6 <0> padrange[@a:1,2] l/1 -# 7 <@> sort lK/INPLACE -# 8 <@> leave[1 ref] vKP/REFC +# 6 <0> pushmark s +# 7 <0> padav[@a:1,2] lRM* +# 8 <@> sort lK/INPLACE +# 9 <@> leave[1 ref] vKP/REFC EONT_EONT checkOptree ( name => 'sub {my @a; @a = sort @a; push @a, 1}', code => sub {my @a; @a = sort @a; push @a, 1}, bcopts => '-exec', debug => 0, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main -437 optree.t:325) v:>,<,% +1 <;> nextstate(main -437 optree.t:325) v 2 <0> padav[@a:-437,-436] vM/LVINTRO -3 <;> nextstate(main -436 optree.t:325) v:>,<,% +3 <;> nextstate(main -436 optree.t:325) v 4 <0> pushmark s -5 <0> padrange[@a:-437,-436] l/1 -6 <@> sort lK/INPLACE -7 <;> nextstate(main -436 optree.t:325) v:>,<,%,{ -8 <0> padrange[@a:-437,-436] l/1 -9 <$> const[IV 1] s -a <@> push[t3] sK/2 -b <1> leavesub[1 ref] K/REFC,1 +5 <0> pushmark s +6 <0> padav[@a:-437,-436] lRM* +7 <@> sort lK/INPLACE +8 <;> nextstate(main -436 optree.t:325) v +9 <0> pushmark s +a <0> padav[@a:-437,-436] lRM +b <$> const[IV 1] s +c <@> push[t3] sK/2 +d <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 429 optree_sort.t:219) v:>,<,% +# 1 <;> nextstate(main 429 optree_sort.t:219) v # 2 <0> padav[@a:429,430] vM/LVINTRO -# 3 <;> nextstate(main 430 optree_sort.t:220) v:>,<,% +# 3 <;> nextstate(main 430 optree_sort.t:220) v # 4 <0> pushmark s -# 5 <0> padrange[@a:429,430] l/1 -# 6 <@> sort lK/INPLACE -# 7 <;> nextstate(main 430 optree_sort.t:220) v:>,<,%,{ -# 8 <0> padrange[@a:429,430] l/1 -# 9 <$> const(IV 1) s -# a <@> push[t3] sK/2 -# b <1> leavesub[1 ref] K/REFC,1 +# 5 <0> pushmark s +# 6 <0> padav[@a:429,430] lRM* +# 7 <@> sort lK/INPLACE +# 8 <;> nextstate(main 430 optree_sort.t:220) v +# 9 <0> pushmark s +# a <0> padav[@a:429,430] lRM +# b <$> const(IV 1) s +# c <@> push[t3] sK/2 +# d <1> leavesub[1 ref] K/REFC,1 EONT_EONT checkOptree ( name => 'sub {my @a; @a = sort @a; 1}', code => sub {my @a; @a = sort @a; 1}, bcopts => '-exec', debug => 0, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main -437 optree.t:325) v:>,<,% +1 <;> nextstate(main -437 optree.t:325) v 2 <0> padav[@a:-437,-436] vM/LVINTRO -3 <;> nextstate(main -436 optree.t:325) v:>,<,% +3 <;> nextstate(main -436 optree.t:325) v 4 <0> pushmark s -5 <0> padrange[@a:-437,-436] l/1 -6 <@> sort lK/INPLACE -7 <;> nextstate(main -436 optree.t:346) v:>,<,%,{ -8 <$> const[IV 1] s -9 <1> leavesub[1 ref] K/REFC,1 +5 <0> pushmark s +6 <0> padav[@a:-437,-436] lRM* +7 <@> sort lK/INPLACE +8 <;> nextstate(main -436 optree.t:346) v +9 <$> const[IV 1] s +a <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 431 optree_sort.t:250) v:>,<,% +# 1 <;> nextstate(main 431 optree_sort.t:250) v # 2 <0> padav[@a:431,432] vM/LVINTRO -# 3 <;> nextstate(main 432 optree_sort.t:251) v:>,<,% +# 3 <;> nextstate(main 432 optree_sort.t:251) v # 4 <0> pushmark s -# 5 <0> padrange[@a:431,432] l/1 -# 6 <@> sort lK/INPLACE -# 7 <;> nextstate(main 432 optree_sort.t:251) v:>,<,%,{ -# 8 <$> const(IV 1) s -# 9 <1> leavesub[1 ref] K/REFC,1 +# 5 <0> pushmark s +# 6 <0> padav[@a:431,432] lRM* +# 7 <@> sort lK/INPLACE +# 8 <;> nextstate(main 432 optree_sort.t:251) v +# 9 <$> const(IV 1) s +# a <1> leavesub[1 ref] K/REFC,1 EONT_EONT + +} #skip + +__END__ + diff --git a/gnu/usr.bin/perl/ext/B/t/optree_specials.t b/gnu/usr.bin/perl/ext/B/t/optree_specials.t index 3cf354c826e..75d2a8ab1a0 100755 --- a/gnu/usr.bin/perl/ext/B/t/optree_specials.t +++ b/gnu/usr.bin/perl/ext/B/t/optree_specials.t @@ -1,26 +1,21 @@ #!./perl -# This tests the B:: module(s) with CHECK, BEGIN, END and INIT blocks. The -# text excerpts below marked with "# " in front are the expected output. They -# are there twice, EOT for threading, and EONT for a non-threading Perl. The -# output is matched losely. If the match fails even though the "got" and -# "expected" output look exactly the same, then watch for trailing, invisible -# spaces. - BEGIN { - unshift @INC, 't'; + chdir 't'; + @INC = ('../lib', '../ext/B/t'); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; exit 0; } + require './test.pl'; } # import checkOptree(), and %gOpts (containing test state) use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!! use Config; -plan tests => 15; +plan tests => 6; require_ok("B::Concise"); @@ -31,125 +26,96 @@ my $out = runperl( #print "out:$out\n"; -my $src = q[our ($beg, $chk, $init, $end, $uc) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ } UNITCHECK {$uc++}]; +my $src = q[our ($beg, $chk, $init, $end) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ }]; + checkOptree ( name => 'BEGIN', bcopts => 'BEGIN', prog => $src, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # BEGIN 1: -# a <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->a -# 1 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ ->2 +# b <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->b +# 1 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 ->2 # 3 <1> require sK/1 ->4 # 2 <$> const[PV "strict.pm"] s/BARE ->3 -# 4 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ ->5 +# 4 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 ->5 # - <@> lineseq K ->- -# - <0> null ->5 -# 9 <1> entersub[t1] KS*/TARG,2 ->a -# 5 <0> pushmark s ->6 -# 6 <$> const[PV "strict"] sM ->7 -# 7 <$> const[PV "refs"] sM ->8 -# 8 <$> method_named[PV "unimport"] ->9 +# 5 <;> nextstate(B::Concise -242 Concise.pm:304) /2 ->6 +# a <1> entersub[t1] KS*/TARG,2 ->b +# 6 <0> pushmark s ->7 +# 7 <$> const[PV "strict"] sM ->8 +# 8 <$> const[PV "refs"] sM ->9 +# 9 <$> method_named[PVIV 1520340202] ->a # BEGIN 2: -# k <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq K ->k -# b <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ ->c -# d <1> require sK/1 ->e -# c <$> const[PV "strict.pm"] s/BARE ->d -# e <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ ->f +# m <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->m +# c <;> nextstate(B::Concise -227 Concise.pm:327) v/2 ->d +# e <1> require sK/1 ->f +# d <$> const[PV "warnings.pm"] s/BARE ->e +# f <;> nextstate(B::Concise -227 Concise.pm:327) v/2 ->g # - <@> lineseq K ->- -# - <0> null ->f -# j <1> entersub[t1] KS*/TARG,2 ->k -# f <0> pushmark s ->g -# g <$> const[PV "strict"] sM ->h -# h <$> const[PV "refs"] sM ->i -# i <$> method_named[PV "unimport"] ->j +# g <;> nextstate(B::Concise -227 Concise.pm:327) /2 ->h +# l <1> entersub[t1] KS*/TARG,2 ->m +# h <0> pushmark s ->i +# i <$> const[PV "warnings"] sM ->j +# j <$> const[PV "qw"] sM ->k +# k <$> method_named[PVIV 1520340202] ->l # BEGIN 3: -# u <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->u -# l <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ ->m -# n <1> require sK/1 ->o -# m <$> const[PV "warnings.pm"] s/BARE ->n -# o <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ ->p -# - <@> lineseq K ->- -# - <0> null ->p -# t <1> entersub[t1] KS*/TARG,2 ->u -# p <0> pushmark s ->q -# q <$> const[PV "warnings"] sM ->r -# r <$> const[PV "qw"] sM ->s -# s <$> method_named[PV "unimport"] ->t -# BEGIN 4: -# y <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->y -# v <;> nextstate(main 2 -e:1) v:>,<,%,{ ->w -# x <1> postinc[t3] sK/1 ->y -# - <1> ex-rv2sv sKRM/1 ->x -# w <#> gvsv[*beg] s ->x +# q <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->q +# n <;> nextstate(main 2 -e:3) v ->o +# p <1> postinc[t3] sK/1 ->q +# - <1> ex-rv2sv sKRM/1 ->p +# o <#> gvsv[*beg] s ->p EOT_EOT # BEGIN 1: -# a <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->a -# 1 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ ->2 +# b <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->b +# 1 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 ->2 # 3 <1> require sK/1 ->4 # 2 <$> const(PV "strict.pm") s/BARE ->3 -# 4 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ ->5 +# 4 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 ->5 # - <@> lineseq K ->- -# - <0> null ->5 -# 9 <1> entersub[t1] KS*/TARG,2 ->a -# 5 <0> pushmark s ->6 -# 6 <$> const(PV "strict") sM ->7 -# 7 <$> const(PV "refs") sM ->8 -# 8 <$> method_named(PV "unimport") ->9 +# 5 <;> nextstate(B::Concise -242 Concise.pm:304) /2 ->6 +# a <1> entersub[t1] KS*/TARG,2 ->b +# 6 <0> pushmark s ->7 +# 7 <$> const(PV "strict") sM ->8 +# 8 <$> const(PV "refs") sM ->9 +# 9 <$> method_named(PVIV 1520340202) ->a # BEGIN 2: -# k <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq K ->k -# b <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ ->c -# d <1> require sK/1 ->e -# c <$> const(PV "strict.pm") s/BARE ->d -# e <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ ->f +# m <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->m +# c <;> nextstate(B::Concise -227 Concise.pm:327) v/2 ->d +# e <1> require sK/1 ->f +# d <$> const(PV "warnings.pm") s/BARE ->e +# f <;> nextstate(B::Concise -227 Concise.pm:327) v/2 ->g # - <@> lineseq K ->- -# - <0> null ->f -# j <1> entersub[t1] KS*/TARG,2 ->k -# f <0> pushmark s ->g -# g <$> const(PV "strict") sM ->h -# h <$> const(PV "refs") sM ->i -# i <$> method_named(PV "unimport") ->j +# g <;> nextstate(B::Concise -227 Concise.pm:327) /2 ->h +# l <1> entersub[t1] KS*/TARG,2 ->m +# h <0> pushmark s ->i +# i <$> const(PV "warnings") sM ->j +# j <$> const(PV "qw") sM ->k +# k <$> method_named(PVIV 1520340202) ->l # BEGIN 3: -# u <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->u -# l <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ ->m -# n <1> require sK/1 ->o -# m <$> const(PV "warnings.pm") s/BARE ->n -# o <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ ->p -# - <@> lineseq K ->- -# - <0> null ->p -# t <1> entersub[t1] KS*/TARG,2 ->u -# p <0> pushmark s ->q -# q <$> const(PV "warnings") sM ->r -# r <$> const(PV "qw") sM ->s -# s <$> method_named(PV "unimport") ->t -# BEGIN 4: -# y <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->y -# v <;> nextstate(main 2 -e:1) v:>,<,%,{ ->w -# x <1> postinc[t2] sK/1 ->y -# - <1> ex-rv2sv sKRM/1 ->x -# w <$> gvsv(*beg) s ->x +# q <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->q +# n <;> nextstate(main 2 -e:3) v ->o +# p <1> postinc[t2] sK/1 ->q +# - <1> ex-rv2sv sKRM/1 ->p +# o <$> gvsv(*beg) s ->p EONT_EONT checkOptree ( name => 'END', bcopts => 'END', prog => $src, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # END 1: # 4 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->4 -# 1 <;> nextstate(main 5 -e:6) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 5 -e:6) v ->2 # 3 <1> postinc[t3] sK/1 ->4 # - <1> ex-rv2sv sKRM/1 ->3 # 2 <#> gvsv[*end] s ->3 @@ -157,7 +123,7 @@ EOT_EOT # END 1: # 4 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->4 -# 1 <;> nextstate(main 5 -e:6) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 5 -e:6) v ->2 # 3 <1> postinc[t2] sK/1 ->4 # - <1> ex-rv2sv sKRM/1 ->3 # 2 <$> gvsv(*end) s ->3 @@ -167,12 +133,11 @@ EONT_EONT checkOptree ( name => 'CHECK', bcopts => 'CHECK', prog => $src, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # CHECK 1: # 4 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->4 -# 1 <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 3 -e:4) v ->2 # 3 <1> postinc[t3] sK/1 ->4 # - <1> ex-rv2sv sKRM/1 ->3 # 2 <#> gvsv[*chk] s ->3 @@ -180,44 +145,22 @@ EOT_EOT # CHECK 1: # 4 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->4 -# 1 <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 3 -e:4) v ->2 # 3 <1> postinc[t2] sK/1 ->4 # - <1> ex-rv2sv sKRM/1 ->3 # 2 <$> gvsv(*chk) s ->3 EONT_EONT -checkOptree ( name => 'UNITCHECK', - bcopts=> 'UNITCHECK', - prog => $src, - strip_open_hints => 1, - expect=> <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# UNITCHECK 1: -# 4 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->4 -# 1 <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2 -# 3 <1> postinc[t3] sK/1 ->4 -# - <1> ex-rv2sv sKRM/1 ->3 -# 2 <#> gvsv[*uc] s ->3 -EOT_EOT -# UNITCHECK 1: -# 4 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->4 -# 1 <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2 -# 3 <1> postinc[t2] sK/1 ->4 -# - <1> ex-rv2sv sKRM/1 ->3 -# 2 <$> gvsv(*uc) s ->3 -EONT_EONT checkOptree ( name => 'INIT', bcopts => 'INIT', #todo => 'get working', prog => $src, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # INIT 1: # 4 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->4 -# 1 <;> nextstate(main 4 -e:5) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 4 -e:5) v ->2 # 3 <1> postinc[t3] sK/1 ->4 # - <1> ex-rv2sv sKRM/1 ->3 # 2 <#> gvsv[*init] s ->3 @@ -225,211 +168,105 @@ EOT_EOT # INIT 1: # 4 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->4 -# 1 <;> nextstate(main 4 -e:5) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 4 -e:5) v ->2 # 3 <1> postinc[t2] sK/1 ->4 # - <1> ex-rv2sv sKRM/1 ->3 # 2 <$> gvsv(*init) s ->3 EONT_EONT -checkOptree ( name => 'all of BEGIN END INIT CHECK UNITCHECK -exec', - bcopts => [qw/ BEGIN END INIT CHECK UNITCHECK -exec /], +checkOptree ( name => 'all of BEGIN END INIT CHECK -exec', + bcopts => [qw/ BEGIN END INIT CHECK -exec /], + #todo => 'get working', prog => $src, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # BEGIN 1: -# 1 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ +# 1 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 # 2 <$> const[PV "strict.pm"] s/BARE # 3 <1> require sK/1 -# 4 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ -# 5 <0> pushmark s -# 6 <$> const[PV "strict"] sM -# 7 <$> const[PV "refs"] sM -# 8 <$> method_named[PV "unimport"] -# 9 <1> entersub[t1] KS*/TARG,2 -# a <1> leavesub[1 ref] K/REFC,1 +# 4 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 +# 5 <;> nextstate(B::Concise -242 Concise.pm:304) /2 +# 6 <0> pushmark s +# 7 <$> const[PV "strict"] sM +# 8 <$> const[PV "refs"] sM +# 9 <$> method_named[PVIV 1520340202] +# a <1> entersub[t1] KS*/TARG,2 +# b <1> leavesub[1 ref] K/REFC,1 # BEGIN 2: -# b <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# c <$> const[PV "strict.pm"] s/BARE -# d <1> require sK/1 -# e <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# f <0> pushmark s -# g <$> const[PV "strict"] sM -# h <$> const[PV "refs"] sM -# i <$> method_named[PV "unimport"] -# j <1> entersub[t1] KS*/TARG,2 -# k <1> leavesub[1 ref] K/REFC,1 +# c <;> nextstate(B::Concise -227 Concise.pm:327) v/2 +# d <$> const[PV "warnings.pm"] s/BARE +# e <1> require sK/1 +# f <;> nextstate(B::Concise -227 Concise.pm:327) v/2 +# g <;> nextstate(B::Concise -227 Concise.pm:327) /2 +# h <0> pushmark s +# i <$> const[PV "warnings"] sM +# j <$> const[PV "qw"] sM +# k <$> method_named[PVIV 1520340202] +# l <1> entersub[t1] KS*/TARG,2 +# m <1> leavesub[1 ref] K/REFC,1 # BEGIN 3: -# l <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# m <$> const[PV "warnings.pm"] s/BARE -# n <1> require sK/1 -# o <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# p <0> pushmark s -# q <$> const[PV "warnings"] sM -# r <$> const[PV "qw"] sM -# s <$> method_named[PV "unimport"] -# t <1> entersub[t1] KS*/TARG,2 +# n <;> nextstate(main 2 -e:3) v +# o <#> gvsv[*beg] s +# p <1> postinc[t3] sK/1 +# q <1> leavesub[1 ref] K/REFC,1 +# END 1: +# r <;> nextstate(main 5 -e:6) v +# s <#> gvsv[*end] s +# t <1> postinc[t3] sK/1 # u <1> leavesub[1 ref] K/REFC,1 -# BEGIN 4: -# v <;> nextstate(main 2 -e:1) v:>,<,%,{ -# w <#> gvsv[*beg] s +# INIT 1: +# v <;> nextstate(main 4 -e:5) v +# w <#> gvsv[*init] s # x <1> postinc[t3] sK/1 # y <1> leavesub[1 ref] K/REFC,1 -# END 1: -# z <;> nextstate(main 5 -e:1) v:>,<,%,{ -# 10 <#> gvsv[*end] s +# CHECK 1: +# z <;> nextstate(main 3 -e:4) v +# 10 <#> gvsv[*chk] s # 11 <1> postinc[t3] sK/1 # 12 <1> leavesub[1 ref] K/REFC,1 -# INIT 1: -# 13 <;> nextstate(main 4 -e:1) v:>,<,%,{ -# 14 <#> gvsv[*init] s -# 15 <1> postinc[t3] sK/1 -# 16 <1> leavesub[1 ref] K/REFC,1 -# CHECK 1: -# 17 <;> nextstate(main 3 -e:1) v:>,<,%,{ -# 18 <#> gvsv[*chk] s -# 19 <1> postinc[t3] sK/1 -# 1a <1> leavesub[1 ref] K/REFC,1 -# UNITCHECK 1: -# 1b <;> nextstate(main 6 -e:1) v:>,<,%,{ -# 1c <#> gvsv[*uc] s -# 1d <1> postinc[t3] sK/1 -# 1e <1> leavesub[1 ref] K/REFC,1 EOT_EOT # BEGIN 1: -# 1 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ +# 1 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 # 2 <$> const(PV "strict.pm") s/BARE # 3 <1> require sK/1 -# 4 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ -# 5 <0> pushmark s -# 6 <$> const(PV "strict") sM -# 7 <$> const(PV "refs") sM -# 8 <$> method_named(PV "unimport") -# 9 <1> entersub[t1] KS*/TARG,2 -# a <1> leavesub[1 ref] K/REFC,1 +# 4 <;> nextstate(B::Concise -242 Concise.pm:304) v/2 +# 5 <;> nextstate(B::Concise -242 Concise.pm:304) /2 +# 6 <0> pushmark s +# 7 <$> const(PV "strict") sM +# 8 <$> const(PV "refs") sM +# 9 <$> method_named(PVIV 1520340202) +# a <1> entersub[t1] KS*/TARG,2 +# b <1> leavesub[1 ref] K/REFC,1 # BEGIN 2: -# b <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# c <$> const(PV "strict.pm") s/BARE -# d <1> require sK/1 -# e <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# f <0> pushmark s -# g <$> const(PV "strict") sM -# h <$> const(PV "refs") sM -# i <$> method_named(PV "unimport") -# j <1> entersub[t1] KS*/TARG,2 -# k <1> leavesub[1 ref] K/REFC,1 +# c <;> nextstate(B::Concise -227 Concise.pm:327) v/2 +# d <$> const(PV "warnings.pm") s/BARE +# e <1> require sK/1 +# f <;> nextstate(B::Concise -227 Concise.pm:327) v/2 +# g <;> nextstate(B::Concise -227 Concise.pm:327) /2 +# h <0> pushmark s +# i <$> const(PV "warnings") sM +# j <$> const(PV "qw") sM +# k <$> method_named(PVIV 1520340202) +# l <1> entersub[t1] KS*/TARG,2 +# m <1> leavesub[1 ref] K/REFC,1 # BEGIN 3: -# l <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# m <$> const(PV "warnings.pm") s/BARE -# n <1> require sK/1 -# o <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# p <0> pushmark s -# q <$> const(PV "warnings") sM -# r <$> const(PV "qw") sM -# s <$> method_named(PV "unimport") -# t <1> entersub[t1] KS*/TARG,2 +# n <;> nextstate(main 2 -e:3) v +# o <$> gvsv(*beg) s +# p <1> postinc[t2] sK/1 +# q <1> leavesub[1 ref] K/REFC,1 +# END 1: +# r <;> nextstate(main 5 -e:6) v +# s <$> gvsv(*end) s +# t <1> postinc[t2] sK/1 # u <1> leavesub[1 ref] K/REFC,1 -# BEGIN 4: -# v <;> nextstate(main 2 -e:1) v:>,<,%,{ -# w <$> gvsv(*beg) s +# INIT 1: +# v <;> nextstate(main 4 -e:5) v +# w <$> gvsv(*init) s # x <1> postinc[t2] sK/1 # y <1> leavesub[1 ref] K/REFC,1 -# END 1: -# z <;> nextstate(main 5 -e:1) v:>,<,%,{ -# 10 <$> gvsv(*end) s +# CHECK 1: +# z <;> nextstate(main 3 -e:4) v +# 10 <$> gvsv(*chk) s # 11 <1> postinc[t2] sK/1 # 12 <1> leavesub[1 ref] K/REFC,1 -# INIT 1: -# 13 <;> nextstate(main 4 -e:1) v:>,<,%,{ -# 14 <$> gvsv(*init) s -# 15 <1> postinc[t2] sK/1 -# 16 <1> leavesub[1 ref] K/REFC,1 -# CHECK 1: -# 17 <;> nextstate(main 3 -e:1) v:>,<,%,{ -# 18 <$> gvsv(*chk) s -# 19 <1> postinc[t2] sK/1 -# 1a <1> leavesub[1 ref] K/REFC,1 -# UNITCHECK 1: -# 1b <;> nextstate(main 6 -e:1) v:>,<,%,{ -# 1c <$> gvsv(*uc) s -# 1d <1> postinc[t2] sK/1 -# 1e <1> leavesub[1 ref] K/REFC,1 -EONT_EONT - - -# perl "-I../lib" -MO=Concise,BEGIN,CHECK,INIT,END,-exec -e '$a=$b && print q/foo/' - - - -checkOptree ( name => 'regression test for patch 25352', - bcopts => [qw/ BEGIN END INIT CHECK -exec /], - prog => 'print q/foo/', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# BEGIN 1: -# 1 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ -# 2 <$> const[PV "strict.pm"] s/BARE -# 3 <1> require sK/1 -# 4 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ -# 5 <0> pushmark s -# 6 <$> const[PV "strict"] sM -# 7 <$> const[PV "refs"] sM -# 8 <$> method_named[PV "unimport"] -# 9 <1> entersub[t1] KS*/TARG,2 -# a <1> leavesub[1 ref] K/REFC,1 -# BEGIN 2: -# b <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# c <$> const[PV "strict.pm"] s/BARE -# d <1> require sK/1 -# e <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# f <0> pushmark s -# g <$> const[PV "strict"] sM -# h <$> const[PV "refs"] sM -# i <$> method_named[PV "unimport"] -# j <1> entersub[t1] KS*/TARG,2 -# k <1> leavesub[1 ref] K/REFC,1 -# BEGIN 3: -# l <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# m <$> const[PV "warnings.pm"] s/BARE -# n <1> require sK/1 -# o <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# p <0> pushmark s -# q <$> const[PV "warnings"] sM -# r <$> const[PV "qw"] sM -# s <$> method_named[PV "unimport"] -# t <1> entersub[t1] KS*/TARG,2 -# u <1> leavesub[1 ref] K/REFC,1 -EOT_EOT -# BEGIN 1: -# 1 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ -# 2 <$> const(PV "strict.pm") s/BARE -# 3 <1> require sK/1 -# 4 <;> nextstate(B::Concise -275 Concise.pm:356) v:*,&,{,x*,x&,x$,$ -# 5 <0> pushmark s -# 6 <$> const(PV "strict") sM -# 7 <$> const(PV "refs") sM -# 8 <$> method_named(PV "unimport") -# 9 <1> entersub[t1] KS*/TARG,2 -# a <1> leavesub[1 ref] K/REFC,1 -# BEGIN 2: -# b <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# c <$> const(PV "strict.pm") s/BARE -# d <1> require sK/1 -# e <;> nextstate(B::Concise -265 Concise.pm:367) v:*,&,x*,x&,x$,$ -# f <0> pushmark s -# g <$> const(PV "strict") sM -# h <$> const(PV "refs") sM -# i <$> method_named(PV "unimport") -# j <1> entersub[t1] KS*/TARG,2 -# k <1> leavesub[1 ref] K/REFC,1 -# BEGIN 3: -# l <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# m <$> const(PV "warnings.pm") s/BARE -# n <1> require sK/1 -# o <;> nextstate(B::Concise -254 Concise.pm:386) v:*,&,{,x*,x&,x$,$ -# p <0> pushmark s -# q <$> const(PV "warnings") sM -# r <$> const(PV "qw") sM -# s <$> method_named(PV "unimport") -# t <1> entersub[t1] KS*/TARG,2 -# u <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/gnu/usr.bin/perl/ext/B/t/optree_varinit.t b/gnu/usr.bin/perl/ext/B/t/optree_varinit.t index ca2b59b6ed5..d58135bb231 100755 --- a/gnu/usr.bin/perl/ext/B/t/optree_varinit.t +++ b/gnu/usr.bin/perl/ext/B/t/optree_varinit.t @@ -1,33 +1,32 @@ #!perl BEGIN { - unshift @INC, 't'; + chdir 't'; + @INC = ('../lib', '../ext/B/t'); require Config; if (($Config::Config{'extensions'} !~ /\bB\b/) ){ print "1..0 # Skip -- Perl configured without B module\n"; exit 0; } - if (!$Config::Config{useperlio}) { - print "1..0 # Skip -- need perlio to walk the optree\n"; - exit 0; - } + require './test.pl'; } use OptreeCheck; use Config; -plan tests => 42; +plan tests => 22; +SKIP: { +skip "no perlio in this build", 22 unless $Config::Config{useperlio}; pass("OPTIMIZER TESTS - VAR INITIALIZATION"); checkOptree ( name => 'sub {my $a}', bcopts => '-exec', code => sub {my $a}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 45 optree.t:23) v:>,<,% +# 1 <;> nextstate(main 45 optree.t:23) v # 2 <0> padsv[$a:45,46] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 45 optree.t:23) v:>,<,% +# 1 <;> nextstate(main 45 optree.t:23) v # 2 <0> padsv[$a:45,46] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -35,13 +34,12 @@ EONT_EONT checkOptree ( name => '-exec sub {my $a}', bcopts => '-exec', code => sub {my $a}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 1 <;> nextstate(main 49 optree.t:52) v:>,<,% +# 1 <;> nextstate(main 49 optree.t:52) v # 2 <0> padsv[$a:49,50] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 49 optree.t:45) v:>,<,% +# 1 <;> nextstate(main 49 optree.t:45) v # 2 <0> padsv[$a:49,50] M/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -49,13 +47,12 @@ EONT_EONT checkOptree ( name => 'sub {our $a}', bcopts => '-exec', code => sub {our $a}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main 21 optree.t:47) v:>,<,% +1 <;> nextstate(main 21 optree.t:47) v 2 <#> gvsv[*a] s/OURINTR 3 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 51 optree.t:56) v:>,<,% +# 1 <;> nextstate(main 51 optree.t:56) v # 2 <$> gvsv(*a) s/OURINTR # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -63,13 +60,12 @@ EONT_EONT checkOptree ( name => 'sub {local $a}', bcopts => '-exec', code => sub {local $a}, - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main 23 optree.t:57) v:>,<,%,{ +1 <;> nextstate(main 23 optree.t:57) v 2 <#> gvsv[*a] s/LVINTRO 3 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 53 optree.t:67) v:>,<,%,{ +# 1 <;> nextstate(main 53 optree.t:67) v # 2 <$> gvsv(*a) s/LVINTRO # 3 <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -77,54 +73,50 @@ EONT_EONT checkOptree ( name => 'my $a', prog => 'my $a', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 4 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # 3 <0> padsv[$a:1,2] vM/LVINTRO ->4 EOT_EOT # 4 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # 3 <0> padsv[$a:1,2] vM/LVINTRO ->4 EONT_EONT checkOptree ( name => 'our $a', prog => 'our $a', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 4 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +2 <;> nextstate(main 1 -e:1) v ->3 - <1> ex-rv2sv vK/17 ->4 3 <#> gvsv[*a] s/OURINTR ->4 EOT_EOT # 4 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # - <1> ex-rv2sv vK/17 ->4 # 3 <$> gvsv(*a) s/OURINTR ->4 EONT_EONT -checkOptree ( name => 'local $c', - prog => 'local $c', - errs => ['Name "main::c" used only once: possible typo at -e line 1.'], +checkOptree ( name => 'local $a', + prog => 'local $a', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 4 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +2 <;> nextstate(main 1 -e:1) v ->3 - <1> ex-rv2sv vKM/129 ->4 -3 <#> gvsv[*c] s/LVINTRO ->4 +3 <#> gvsv[*a] s/LVINTRO ->4 EOT_EOT # 4 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # - <1> ex-rv2sv vKM/129 ->4 -# 3 <$> gvsv(*c) s/LVINTRO ->4 +# 3 <$> gvsv(*a) s/LVINTRO ->4 EONT_EONT pass("MY, OUR, LOCAL, BOTH SUB AND MAIN, = undef"); @@ -132,32 +124,26 @@ pass("MY, OUR, LOCAL, BOTH SUB AND MAIN, = undef"); checkOptree ( name => 'sub {my $a=undef}', code => sub {my $a=undef}, bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -5 <1> leavesub[1 ref] K/REFC,1 ->(end) -- <@> lineseq KP ->5 -1 <;> nextstate(main 641 optree_varinit.t:130) v:>,<,% ->2 -4 <2> sassign sKS/2 ->5 -2 <0> undef s ->3 -3 <0> padsv[$a:641,642] sRM*/LVINTRO ->4 +3 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <@> lineseq KP ->3 +1 <;> nextstate(main 24 optree.t:99) v ->2 +2 <0> padsv[$a:24,25] sRM*/LVINTRO ->3 EOT_EOT -# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->5 -# 1 <;> nextstate(main 641 optree_varinit.t:130) v:>,<,% ->2 -# 4 <2> sassign sKS/2 ->5 -# 2 <0> undef s ->3 -# 3 <0> padsv[$a:641,642] sRM*/LVINTRO ->4 +# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->3 +# 1 <;> nextstate(main 54 optree.t:149) v ->2 +# 2 <0> padsv[$a:54,55] sRM*/LVINTRO ->3 EONT_EONT checkOptree ( name => 'sub {our $a=undef}', code => sub {our $a=undef}, note => 'the global must be reset', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 5 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->5 -1 <;> nextstate(main 26 optree.t:109) v:>,<,%,{ ->2 +1 <;> nextstate(main 26 optree.t:109) v ->2 4 <2> sassign sKS/2 ->5 2 <0> undef s ->3 - <1> ex-rv2sv sKRM*/17 ->4 @@ -165,7 +151,7 @@ checkOptree ( name => 'sub {our $a=undef}', EOT_EOT # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->5 -# 1 <;> nextstate(main 446 optree_varinit.t:137) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 446 optree_varinit.t:137) v ->2 # 4 <2> sassign sKS/2 ->5 # 2 <0> undef s ->3 # - <1> ex-rv2sv sKRM*/17 ->4 @@ -176,11 +162,10 @@ checkOptree ( name => 'sub {local $a=undef}', code => sub {local $a=undef}, note => 'local not used enough to bother', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 5 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->5 -1 <;> nextstate(main 28 optree.t:122) v:>,<,%,{ ->2 +1 <;> nextstate(main 28 optree.t:122) v ->2 4 <2> sassign sKS/2 ->5 2 <0> undef s ->3 - <1> ex-rv2sv sKRM*/129 ->4 @@ -188,7 +173,7 @@ checkOptree ( name => 'sub {local $a=undef}', EOT_EOT # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->5 -# 1 <;> nextstate(main 58 optree.t:141) v:>,<,%,{ ->2 +# 1 <;> nextstate(main 58 optree.t:141) v ->2 # 4 <2> sassign sKS/2 ->5 # 2 <0> undef s ->3 # - <1> ex-rv2sv sKRM*/129 ->4 @@ -198,32 +183,26 @@ EONT_EONT checkOptree ( name => 'my $a=undef', prog => 'my $a=undef', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -6 <@> leave[1 ref] vKP/REFC ->(end) +4 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 -5 <2> sassign vKS/2 ->6 -3 <0> undef s ->4 -4 <0> padsv[$a:1,2] sRM*/LVINTRO ->5 +2 <;> nextstate(main 1 -e:1) v ->3 +3 <0> padsv[$a:1,2] vRM*/LVINTRO ->4 EOT_EOT -# 6 <@> leave[1 ref] vKP/REFC ->(end) +# 4 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 -# 5 <2> sassign vKS/2 ->6 -# 3 <0> undef s ->4 -# 4 <0> padsv[$a:1,2] sRM*/LVINTRO ->5 +# 2 <;> nextstate(main 1 -e:1) v ->3 +# 3 <0> padsv[$a:1,2] vRM*/LVINTRO ->4 EONT_EONT checkOptree ( name => 'our $a=undef', prog => 'our $a=undef', note => 'global must be reassigned', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 6 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +2 <;> nextstate(main 1 -e:1) v ->3 5 <2> sassign vKS/2 ->6 3 <0> undef s ->4 - <1> ex-rv2sv sKRM*/17 ->5 @@ -231,49 +210,46 @@ checkOptree ( name => 'our $a=undef', EOT_EOT # 6 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # 5 <2> sassign vKS/2 ->6 # 3 <0> undef s ->4 # - <1> ex-rv2sv sKRM*/17 ->5 # 4 <$> gvsv(*a) s/OURINTR ->5 EONT_EONT -checkOptree ( name => 'local $c=undef', - prog => 'local $c=undef', - errs => ['Name "main::c" used only once: possible typo at -e line 1.'], - note => 'locals are rare, probably not worth doing', +checkOptree ( name => 'local $a=undef', + prog => 'local $a=undef', + note => 'locals are rare, probly not worth doing', bcopts => '-basic', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 6 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +2 <;> nextstate(main 1 -e:1) v ->3 5 <2> sassign vKS/2 ->6 3 <0> undef s ->4 - <1> ex-rv2sv sKRM*/129 ->5 -4 <#> gvsv[*c] s/LVINTRO ->5 +4 <#> gvsv[*a] s/LVINTRO ->5 EOT_EOT # 6 <@> leave[1 ref] vKP/REFC ->(end) # 1 <0> enter ->2 -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3 +# 2 <;> nextstate(main 1 -e:1) v ->3 # 5 <2> sassign vKS/2 ->6 # 3 <0> undef s ->4 # - <1> ex-rv2sv sKRM*/129 ->5 -# 4 <$> gvsv(*c) s/LVINTRO ->5 +# 4 <$> gvsv(*a) s/LVINTRO ->5 EONT_EONT checkOptree ( name => 'sub {my $a=()}', code => sub {my $a=()}, bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main -439 optree.t:105) v:>,<,% +1 <;> nextstate(main -439 optree.t:105) v 2 <0> stub sP 3 <0> padsv[$a:-439,-438] sRM*/LVINTRO 4 <2> sassign sKS/2 5 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 438 optree_varinit.t:247) v:>,<,% +# 1 <;> nextstate(main 438 optree_varinit.t:247) v # 2 <0> stub sP # 3 <0> padsv[$a:438,439] sRM*/LVINTRO # 4 <2> sassign sKS/2 @@ -284,15 +260,14 @@ checkOptree ( name => 'sub {our $a=()}', code => sub {our $a=()}, #todo => 'probly not worth doing', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main 31 optree.t:177) v:>,<,%,{ +1 <;> nextstate(main 31 optree.t:177) v 2 <0> stub sP 3 <#> gvsv[*a] s/OURINTR 4 <2> sassign sKS/2 5 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 440 optree_varinit.t:262) v:>,<,%,{ +# 1 <;> nextstate(main 440 optree_varinit.t:262) v # 2 <0> stub sP # 3 <$> gvsv(*a) s/OURINTR # 4 <2> sassign sKS/2 @@ -303,15 +278,14 @@ checkOptree ( name => 'sub {local $a=()}', code => sub {local $a=()}, #todo => 'probly not worth doing', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -1 <;> nextstate(main 33 optree.t:190) v:>,<,%,{ +1 <;> nextstate(main 33 optree.t:190) v 2 <0> stub sP 3 <#> gvsv[*a] s/LVINTRO 4 <2> sassign sKS/2 5 <1> leavesub[1 ref] K/REFC,1 EOT_EOT -# 1 <;> nextstate(main 63 optree.t:225) v:>,<,%,{ +# 1 <;> nextstate(main 63 optree.t:225) v # 2 <0> stub sP # 3 <$> gvsv(*a) s/LVINTRO # 4 <2> sassign sKS/2 @@ -321,17 +295,16 @@ EONT_EONT checkOptree ( name => 'my $a=()', prog => 'my $a=()', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> stub sP 4 <0> padsv[$a:1,2] sRM*/LVINTRO 5 <2> sassign vKS/2 6 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> stub sP # 4 <0> padsv[$a:1,2] sRM*/LVINTRO # 5 <2> sassign vKS/2 @@ -342,41 +315,38 @@ checkOptree ( name => 'our $a=()', prog => 'our $a=()', #todo => 'probly not worth doing', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> stub sP 4 <#> gvsv[*a] s/OURINTR 5 <2> sassign vKS/2 6 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> stub sP # 4 <$> gvsv(*a) s/OURINTR # 5 <2> sassign vKS/2 # 6 <@> leave[1 ref] vKP/REFC EONT_EONT -checkOptree ( name => 'local $c=()', - prog => 'local $c=()', - errs => ['Name "main::c" used only once: possible typo at -e line 1.'], +checkOptree ( name => 'local $a=()', + prog => 'local $a=()', #todo => 'probly not worth doing', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); 1 <0> enter -2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +2 <;> nextstate(main 1 -e:1) v 3 <0> stub sP -4 <#> gvsv[*c] s/LVINTRO +4 <#> gvsv[*a] s/LVINTRO 5 <2> sassign vKS/2 6 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> stub sP -# 4 <$> gvsv(*c) s/LVINTRO +# 4 <$> gvsv(*a) s/LVINTRO # 5 <2> sassign vKS/2 # 6 <@> leave[1 ref] vKP/REFC EONT_EONT @@ -385,19 +355,27 @@ checkOptree ( name => 'my ($a,$b)=()', prog => 'my ($a,$b)=()', #todo => 'probly not worth doing', bcopts => '-exec', - strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> pushmark s -# 4 <0> padrange[$a:1,2; $b:1,2] lRM/LVINTRO,2 -# 5 <2> aassign[t3] vKS -# 6 <@> leave[1 ref] vKP/REFC +# 4 <0> pushmark sRM*/128 +# 5 <0> padsv[$a:1,2] lRM*/LVINTRO +# 6 <0> padsv[$b:1,2] lRM*/LVINTRO +# 7 <2> aassign[t3] vKS +# 8 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter -# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ +# 2 <;> nextstate(main 1 -e:1) v # 3 <0> pushmark s -# 4 <0> padrange[$a:1,2; $b:1,2] lRM/LVINTRO,2 -# 5 <2> aassign[t3] vKS -# 6 <@> leave[1 ref] vKP/REFC +# 4 <0> pushmark sRM*/128 +# 5 <0> padsv[$a:1,2] lRM*/LVINTRO +# 6 <0> padsv[$b:1,2] lRM*/LVINTRO +# 7 <2> aassign[t3] vKS +# 8 <@> leave[1 ref] vKP/REFC EONT_EONT + +} #skip + +__END__ + |