projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to CPAN 1.87_63
[p5sagit/p5-mst-13.2.git] / ext / B / t / f_sort.t
CommitLineData
cc02ea56 1#!perl
2
3BEGIN {
5638aaac 4 if ($ENV{PERL_CORE}){
5 chdir('t') if -d 't';
6 @INC = ('.', '../lib', '../ext/B/t');
7 } else {
8 unshift @INC, 't';
9 push @INC, "../../t";
10 }
9cd8f857 11 require Config;
12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13 print "1..0 # Skip -- Perl configured without B module\n";
14 exit 0;
15 }
7f046282 16 if (!$Config::Config{useperlio}) {
17 print "1..0 # Skip -- need perlio to walk the optree\n";
18 exit 0;
19 }
19e169bf 20 # require q(test.pl); # now done by OptreeCheck;
cc02ea56 21}
22use OptreeCheck;
23plan tests => 20;
24
19e169bf 25=head1 f_sort.t
26
27Code test snippets here are adapted from `perldoc -f map`
28
29Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the
30(map|grep)(start|while) opcodes have different flags in 5.9, their
31private flags /1, /2 are gone in blead (for the cases covered)
32
33When the optree stuff was integrated into 5.8.6, these tests failed,
34and were todo'd. Theyre now done, by version-specific tweaking in
35mkCheckRex(), therefore the skip is removed too.
cc02ea56 36
7ce9b5fb 37=head1 Test Notes
cc02ea56 38
39# chunk: #!perl
40#examples poached from perldoc -f sort
41
7ce9b5fb 42NOTE: name is no longer a required arg for checkOptree, as label is
43synthesized out of others. HOWEVER, if the test-code has newlines in
44it, the label must be overridden by an explicit name.
45
46This is because t/TEST is quite particular about the test output it
47processes, and multi-line labels violate its 1-line-per-test
48expectations.
49
cc02ea56 50=for gentest
51
52# chunk: # sort lexically
53@articles = sort @files;
54
55=cut
56
57checkOptree(note => q{},
58 bcopts => q{-exec},
59 code => q{@articles = sort @files; },
60 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
61# 1 <;> nextstate(main 545 (eval 15):1) v
62# 2 <0> pushmark s
63# 3 <0> pushmark s
64# 4 <#> gv[*files] s
65# 5 <1> rv2av[t4] lK/1
66# 6 <@> sort lK
67# 7 <0> pushmark s
68# 8 <#> gv[*articles] s
69# 9 <1> rv2av[t2] lKRM*/1
9e84f099 70# a <2> aassign[t5] KS/COMMON
cc02ea56 71# b <1> leavesub[1 ref] K/REFC,1
72EOT_EOT
73# 1 <;> nextstate(main 545 (eval 15):1) v
74# 2 <0> pushmark s
75# 3 <0> pushmark s
76# 4 <$> gv(*files) s
77# 5 <1> rv2av[t2] lK/1
78# 6 <@> sort lK
79# 7 <0> pushmark s
80# 8 <$> gv(*articles) s
81# 9 <1> rv2av[t1] lKRM*/1
9e84f099 82# a <2> aassign[t3] KS/COMMON
cc02ea56 83# b <1> leavesub[1 ref] K/REFC,1
84EONT_EONT
85
86
87=for gentest
88
89# chunk: # same thing, but with explicit sort routine
90@articles = sort {$a cmp $b} @files;
91
92=cut
93
94checkOptree(note => q{},
95 bcopts => q{-exec},
96 code => q{@articles = sort {$a cmp $b} @files; },
97 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
98# 1 <;> nextstate(main 546 (eval 15):1) v
99# 2 <0> pushmark s
100# 3 <0> pushmark s
101# 4 <#> gv[*files] s
102# 5 <1> rv2av[t7] lK/1
103# 6 <@> sort lK
104# 7 <0> pushmark s
105# 8 <#> gv[*articles] s
106# 9 <1> rv2av[t2] lKRM*/1
9e84f099 107# a <2> aassign[t3] KS/COMMON
cc02ea56 108# b <1> leavesub[1 ref] K/REFC,1
109EOT_EOT
110# 1 <;> nextstate(main 546 (eval 15):1) v
111# 2 <0> pushmark s
112# 3 <0> pushmark s
113# 4 <$> gv(*files) s
114# 5 <1> rv2av[t3] lK/1
115# 6 <@> sort lK
116# 7 <0> pushmark s
117# 8 <$> gv(*articles) s
118# 9 <1> rv2av[t1] lKRM*/1
9e84f099 119# a <2> aassign[t2] KS/COMMON
cc02ea56 120# b <1> leavesub[1 ref] K/REFC,1
121EONT_EONT
122
123
124=for gentest
125
126# chunk: # now case-insensitively
127@articles = sort {uc($a) cmp uc($b)} @files;
128
129=cut
130
131checkOptree(note => q{},
132 bcopts => q{-exec},
133 code => q{@articles = sort {uc($a) cmp uc($b)} @files; },
134 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
135# 1 <;> nextstate(main 546 (eval 15):1) v
136# 2 <0> pushmark s
137# 3 <0> pushmark s
138# 4 <#> gv[*files] s
139# 5 <1> rv2av[t9] lK/1
140# 6 <@> sort lKS*
141# 7 <0> pushmark s
142# 8 <#> gv[*articles] s
143# 9 <1> rv2av[t2] lKRM*/1
9e84f099 144# a <2> aassign[t10] KS/COMMON
cc02ea56 145# b <1> leavesub[1 ref] K/REFC,1
146EOT_EOT
147# 1 <;> nextstate(main 546 (eval 15):1) v
148# 2 <0> pushmark s
149# 3 <0> pushmark s
150# 4 <$> gv(*files) s
151# 5 <1> rv2av[t5] lK/1
152# 6 <@> sort lKS*
153# 7 <0> pushmark s
154# 8 <$> gv(*articles) s
155# 9 <1> rv2av[t1] lKRM*/1
9e84f099 156# a <2> aassign[t6] KS/COMMON
cc02ea56 157# b <1> leavesub[1 ref] K/REFC,1
158EONT_EONT
159
160
161=for gentest
162
163# chunk: # same thing in reversed order
164@articles = sort {$b cmp $a} @files;
165
166=cut
167
168checkOptree(note => q{},
169 bcopts => q{-exec},
170 code => q{@articles = sort {$b cmp $a} @files; },
171 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
172# 1 <;> nextstate(main 546 (eval 15):1) v
173# 2 <0> pushmark s
174# 3 <0> pushmark s
175# 4 <#> gv[*files] s
176# 5 <1> rv2av[t7] lK/1
6c3fb703 177# 6 <@> sort lK/DESC
cc02ea56 178# 7 <0> pushmark s
179# 8 <#> gv[*articles] s
180# 9 <1> rv2av[t2] lKRM*/1
9e84f099 181# a <2> aassign[t3] KS/COMMON
cc02ea56 182# b <1> leavesub[1 ref] K/REFC,1
183EOT_EOT
184# 1 <;> nextstate(main 546 (eval 15):1) v
185# 2 <0> pushmark s
186# 3 <0> pushmark s
187# 4 <$> gv(*files) s
188# 5 <1> rv2av[t3] lK/1
6c3fb703 189# 6 <@> sort lK/DESC
cc02ea56 190# 7 <0> pushmark s
191# 8 <$> gv(*articles) s
192# 9 <1> rv2av[t1] lKRM*/1
9e84f099 193# a <2> aassign[t2] KS/COMMON
cc02ea56 194# b <1> leavesub[1 ref] K/REFC,1
195EONT_EONT
196
197
198=for gentest
199
200# chunk: # sort numerically ascending
201@articles = sort {$a <=> $b} @files;
202
203=cut
204
205checkOptree(note => q{},
206 bcopts => q{-exec},
207 code => q{@articles = sort {$a <=> $b} @files; },
208 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
209# 1 <;> nextstate(main 546 (eval 15):1) v
210# 2 <0> pushmark s
211# 3 <0> pushmark s
212# 4 <#> gv[*files] s
213# 5 <1> rv2av[t7] lK/1
214# 6 <@> sort lK/NUM
215# 7 <0> pushmark s
216# 8 <#> gv[*articles] s
217# 9 <1> rv2av[t2] lKRM*/1
9e84f099 218# a <2> aassign[t3] KS/COMMON
cc02ea56 219# b <1> leavesub[1 ref] K/REFC,1
220EOT_EOT
221# 1 <;> nextstate(main 546 (eval 15):1) v
222# 2 <0> pushmark s
223# 3 <0> pushmark s
224# 4 <$> gv(*files) s
225# 5 <1> rv2av[t3] lK/1
226# 6 <@> sort lK/NUM
227# 7 <0> pushmark s
228# 8 <$> gv(*articles) s
229# 9 <1> rv2av[t1] lKRM*/1
9e84f099 230# a <2> aassign[t2] KS/COMMON
cc02ea56 231# b <1> leavesub[1 ref] K/REFC,1
232EONT_EONT
233
234
235=for gentest
236
237# chunk: # sort numerically descending
238@articles = sort {$b <=> $a} @files;
239
240=cut
241
242checkOptree(note => q{},
243 bcopts => q{-exec},
244 code => q{@articles = sort {$b <=> $a} @files; },
245 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
246# 1 <;> nextstate(main 587 (eval 26):1) v
247# 2 <0> pushmark s
248# 3 <0> pushmark s
249# 4 <#> gv[*files] s
250# 5 <1> rv2av[t7] lK/1
6c3fb703 251# 6 <@> sort lK/DESC,NUM
cc02ea56 252# 7 <0> pushmark s
253# 8 <#> gv[*articles] s
254# 9 <1> rv2av[t2] lKRM*/1
9e84f099 255# a <2> aassign[t3] KS/COMMON
cc02ea56 256# b <1> leavesub[1 ref] K/REFC,1
257EOT_EOT
258# 1 <;> nextstate(main 546 (eval 15):1) v
259# 2 <0> pushmark s
260# 3 <0> pushmark s
261# 4 <$> gv(*files) s
262# 5 <1> rv2av[t3] lK/1
6c3fb703 263# 6 <@> sort lK/DESC,NUM
cc02ea56 264# 7 <0> pushmark s
265# 8 <$> gv(*articles) s
266# 9 <1> rv2av[t1] lKRM*/1
9e84f099 267# a <2> aassign[t2] KS/COMMON
cc02ea56 268# b <1> leavesub[1 ref] K/REFC,1
269EONT_EONT
270
271
272=for gentest
273
274# chunk: # this sorts the %age hash by value instead of key
275# using an in-line function
276@eldest = sort { $age{$b} <=> $age{$a} } keys %age;
277
278=cut
279
280checkOptree(note => q{},
281 bcopts => q{-exec},
282 code => q{@eldest = sort { $age{$b} <=> $age{$a} } keys %age; },
283 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
284# 1 <;> nextstate(main 592 (eval 28):1) v
285# 2 <0> pushmark s
286# 3 <0> pushmark s
287# 4 <#> gv[*age] s
288# 5 <1> rv2hv[t9] lKRM/1
289# 6 <1> keys[t10] lK/1
290# 7 <@> sort lKS*
291# 8 <0> pushmark s
292# 9 <#> gv[*eldest] s
293# a <1> rv2av[t2] lKRM*/1
9e84f099 294# b <2> aassign[t11] KS/COMMON
cc02ea56 295# c <1> leavesub[1 ref] K/REFC,1
296EOT_EOT
297# 1 <;> nextstate(main 546 (eval 15):1) v
298# 2 <0> pushmark s
299# 3 <0> pushmark s
300# 4 <$> gv(*age) s
301# 5 <1> rv2hv[t3] lKRM/1
302# 6 <1> keys[t4] lK/1
303# 7 <@> sort lKS*
304# 8 <0> pushmark s
305# 9 <$> gv(*eldest) s
306# a <1> rv2av[t1] lKRM*/1
9e84f099 307# b <2> aassign[t5] KS/COMMON
cc02ea56 308# c <1> leavesub[1 ref] K/REFC,1
309EONT_EONT
310
311
312=for gentest
313
314# chunk: # sort using explicit subroutine name
315sub byage {
316 $age{$a} <=> $age{$b}; # presuming numeric
317}
318@sortedclass = sort byage @class;
319
320=cut
321
322checkOptree(note => q{},
323 bcopts => q{-exec},
324 code => q{sub byage { $age{$a} <=> $age{$b}; } @sortedclass = sort byage @class; },
325 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
326# 1 <;> nextstate(main 597 (eval 30):1) v
327# 2 <0> pushmark s
328# 3 <0> pushmark s
329# 4 <$> const[PV "byage"] s/BARE
330# 5 <#> gv[*class] s
331# 6 <1> rv2av[t4] lK/1
332# 7 <@> sort lKS
333# 8 <0> pushmark s
334# 9 <#> gv[*sortedclass] s
335# a <1> rv2av[t2] lKRM*/1
9e84f099 336# b <2> aassign[t5] KS/COMMON
cc02ea56 337# c <1> leavesub[1 ref] K/REFC,1
338EOT_EOT
339# 1 <;> nextstate(main 546 (eval 15):1) v
340# 2 <0> pushmark s
341# 3 <0> pushmark s
342# 4 <$> const(PV "byage") s/BARE
343# 5 <$> gv(*class) s
344# 6 <1> rv2av[t2] lK/1
345# 7 <@> sort lKS
346# 8 <0> pushmark s
347# 9 <$> gv(*sortedclass) s
348# a <1> rv2av[t1] lKRM*/1
9e84f099 349# b <2> aassign[t3] KS/COMMON
cc02ea56 350# c <1> leavesub[1 ref] K/REFC,1
351EONT_EONT
352
353
354=for gentest
355
356# chunk: sub backwards { $b cmp $a }
357@harry = qw(dog cat x Cain Abel);
358@george = qw(gone chased yz Punished Axed);
359print sort @harry;
360# prints AbelCaincatdogx
361print sort backwards @harry;
362# prints xdogcatCainAbel
363print sort @george, 'to', @harry;
364# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
365
366=cut
367
7ce9b5fb 368checkOptree(name => q{sort USERSUB LIST },
cc02ea56 369 bcopts => q{-exec},
cc02ea56 370 code => q{sub backwards { $b cmp $a }
371 @harry = qw(dog cat x Cain Abel);
372 @george = qw(gone chased yz Punished Axed);
373 print sort @harry; print sort backwards @harry;
374 print sort @george, 'to', @harry; },
375 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
376# 1 <;> nextstate(main 602 (eval 32):2) v
377# 2 <0> pushmark s
378# 3 <$> const[PV "dog"] s
379# 4 <$> const[PV "cat"] s
380# 5 <$> const[PV "x"] s
381# 6 <$> const[PV "Cain"] s
382# 7 <$> const[PV "Abel"] s
383# 8 <0> pushmark s
384# 9 <#> gv[*harry] s
385# a <1> rv2av[t2] lKRM*/1
386# b <2> aassign[t3] vKS
387# c <;> nextstate(main 602 (eval 32):3) v
388# d <0> pushmark s
389# e <$> const[PV "gone"] s
390# f <$> const[PV "chased"] s
391# g <$> const[PV "yz"] s
392# h <$> const[PV "Punished"] s
393# i <$> const[PV "Axed"] s
394# j <0> pushmark s
395# k <#> gv[*george] s
396# l <1> rv2av[t5] lKRM*/1
397# m <2> aassign[t6] vKS
d5ec2987 398# n <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56 399# o <0> pushmark s
400# p <0> pushmark s
401# q <#> gv[*harry] s
402# r <1> rv2av[t8] lK/1
403# s <@> sort lK
404# t <@> print vK
d5ec2987 405# u <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56 406# v <0> pushmark s
407# w <0> pushmark s
408# x <$> const[PV "backwards"] s/BARE
409# y <#> gv[*harry] s
410# z <1> rv2av[t10] lK/1
411# 10 <@> sort lKS
412# 11 <@> print vK
d5ec2987 413# 12 <;> nextstate(main 602 (eval 32):5) v:{
cc02ea56 414# 13 <0> pushmark s
415# 14 <0> pushmark s
416# 15 <#> gv[*george] s
417# 16 <1> rv2av[t12] lK/1
418# 17 <$> const[PV "to"] s
419# 18 <#> gv[*harry] s
420# 19 <1> rv2av[t14] lK/1
421# 1a <@> sort lK
422# 1b <@> print sK
423# 1c <1> leavesub[1 ref] K/REFC,1
424EOT_EOT
425# 1 <;> nextstate(main 602 (eval 32):2) v
426# 2 <0> pushmark s
427# 3 <$> const(PV "dog") s
428# 4 <$> const(PV "cat") s
429# 5 <$> const(PV "x") s
430# 6 <$> const(PV "Cain") s
431# 7 <$> const(PV "Abel") s
432# 8 <0> pushmark s
433# 9 <$> gv(*harry) s
434# a <1> rv2av[t1] lKRM*/1
435# b <2> aassign[t2] vKS
436# c <;> nextstate(main 602 (eval 32):3) v
437# d <0> pushmark s
438# e <$> const(PV "gone") s
439# f <$> const(PV "chased") s
440# g <$> const(PV "yz") s
441# h <$> const(PV "Punished") s
442# i <$> const(PV "Axed") s
443# j <0> pushmark s
444# k <$> gv(*george) s
445# l <1> rv2av[t3] lKRM*/1
446# m <2> aassign[t4] vKS
d5ec2987 447# n <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56 448# o <0> pushmark s
449# p <0> pushmark s
450# q <$> gv(*harry) s
451# r <1> rv2av[t5] lK/1
452# s <@> sort lK
453# t <@> print vK
d5ec2987 454# u <;> nextstate(main 602 (eval 32):4) v:{
cc02ea56 455# v <0> pushmark s
456# w <0> pushmark s
457# x <$> const(PV "backwards") s/BARE
458# y <$> gv(*harry) s
459# z <1> rv2av[t6] lK/1
460# 10 <@> sort lKS
461# 11 <@> print vK
d5ec2987 462# 12 <;> nextstate(main 602 (eval 32):5) v:{
cc02ea56 463# 13 <0> pushmark s
464# 14 <0> pushmark s
465# 15 <$> gv(*george) s
466# 16 <1> rv2av[t7] lK/1
467# 17 <$> const(PV "to") s
468# 18 <$> gv(*harry) s
469# 19 <1> rv2av[t8] lK/1
470# 1a <@> sort lK
471# 1b <@> print sK
472# 1c <1> leavesub[1 ref] K/REFC,1
473EONT_EONT
474
475
476=for gentest
477
478# chunk: # inefficiently sort by descending numeric compare using
479# the first integer after the first = sign, or the
480# whole record case-insensitively otherwise
481@new = @old[ sort {
482 $nums[$b] <=> $nums[$a]
483 || $caps[$a] cmp $caps[$b]
484 } 0..$#old ];
485
486=cut
487=for gentest
488
489# chunk: # same thing, but without any temps
490@new = map { $_->[0] }
491sort { $b->[1] <=> $a->[1]
492 || $a->[2] cmp $b->[2]
493 } map { [$_, /=(\d+)/, uc($_)] } @old;
494
495=cut
496
7ce9b5fb 497checkOptree(name => q{Compound sort/map Expression },
cc02ea56 498 bcopts => q{-exec},
499 code => q{ @new = map { $_->[0] }
500 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
501 map { [$_, /=(\d+)/, uc($_)] } @old; },
502 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 503# 1 <;> nextstate(main 609 (eval 34):3) v:{
cc02ea56 504# 2 <0> pushmark s
505# 3 <0> pushmark s
506# 4 <0> pushmark s
507# 5 <0> pushmark s
508# 6 <#> gv[*old] s
509# 7 <1> rv2av[t19] lKM/1
510# 8 <@> mapstart lK*
511# 9 <|> mapwhile(other->a)[t20] lK
512# a <0> enter l
d5ec2987 513# b <;> nextstate(main 608 (eval 34):2) v:{
cc02ea56 514# c <0> pushmark s
515# d <#> gvsv[*_] s
516# e </> match(/"=(\\d+)"/) l/RTIME
517# f <#> gvsv[*_] s
518# g <1> uc[t17] sK/1
78c72037 519# h <@> anonlist sK*/1
520# i <@> leave lKP
cc02ea56 521# goto 9
78c72037 522# j <@> sort lKMS*
523# k <@> mapstart lK*
524# l <|> mapwhile(other->m)[t26] lK
525# m <#> gv[*_] s
526# n <1> rv2sv sKM/DREFAV,1
527# o <1> rv2av[t4] sKR/1
528# p <$> const[IV 0] s
529# q <2> aelem sK/2
cc02ea56 530# - <@> scope lK
78c72037 531# goto l
532# r <0> pushmark s
533# s <#> gv[*new] s
534# t <1> rv2av[t2] lKRM*/1
535# u <2> aassign[t27] KS/COMMON
536# v <1> leavesub[1 ref] K/REFC,1
cc02ea56 537EOT_EOT
d5ec2987 538# 1 <;> nextstate(main 609 (eval 34):3) v:{
cc02ea56 539# 2 <0> pushmark s
540# 3 <0> pushmark s
541# 4 <0> pushmark s
542# 5 <0> pushmark s
543# 6 <$> gv(*old) s
544# 7 <1> rv2av[t10] lKM/1
545# 8 <@> mapstart lK*
546# 9 <|> mapwhile(other->a)[t11] lK
547# a <0> enter l
d5ec2987 548# b <;> nextstate(main 608 (eval 34):2) v:{
cc02ea56 549# c <0> pushmark s
550# d <$> gvsv(*_) s
551# e </> match(/"=(\\d+)"/) l/RTIME
552# f <$> gvsv(*_) s
553# g <1> uc[t9] sK/1
78c72037 554# h <@> anonlist sK*/1
555# i <@> leave lKP
cc02ea56 556# goto 9
78c72037 557# j <@> sort lKMS*
558# k <@> mapstart lK*
559# l <|> mapwhile(other->m)[t12] lK
560# m <$> gv(*_) s
561# n <1> rv2sv sKM/DREFAV,1
562# o <1> rv2av[t2] sKR/1
563# p <$> const(IV 0) s
564# q <2> aelem sK/2
cc02ea56 565# - <@> scope lK
78c72037 566# goto l
567# r <0> pushmark s
568# s <$> gv(*new) s
569# t <1> rv2av[t1] lKRM*/1
570# u <2> aassign[t13] KS/COMMON
571# v <1> leavesub[1 ref] K/REFC,1
cc02ea56 572EONT_EONT
573
574
575=for gentest
576
577# chunk: # using a prototype allows you to use any comparison subroutine
578# as a sort subroutine (including other package's subroutines)
579package other;
580sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
581package main;
582@new = sort other::backwards @old;
583
584=cut
585
7ce9b5fb 586checkOptree(name => q{sort other::sub LIST },
cc02ea56 587 bcopts => q{-exec},
588 code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
589 package main; @new = sort other::backwards @old; },
590 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 591# 1 <;> nextstate(main 614 (eval 36):2) v:{
cc02ea56 592# 2 <0> pushmark s
593# 3 <0> pushmark s
594# 4 <$> const[PV "other::backwards"] s/BARE
595# 5 <#> gv[*old] s
596# 6 <1> rv2av[t4] lK/1
597# 7 <@> sort lKS
598# 8 <0> pushmark s
599# 9 <#> gv[*new] s
600# a <1> rv2av[t2] lKRM*/1
9e84f099 601# b <2> aassign[t5] KS/COMMON
cc02ea56 602# c <1> leavesub[1 ref] K/REFC,1
603EOT_EOT
d5ec2987 604# 1 <;> nextstate(main 614 (eval 36):2) v:{
cc02ea56 605# 2 <0> pushmark s
606# 3 <0> pushmark s
607# 4 <$> const(PV "other::backwards") s/BARE
608# 5 <$> gv(*old) s
609# 6 <1> rv2av[t2] lK/1
610# 7 <@> sort lKS
611# 8 <0> pushmark s
612# 9 <$> gv(*new) s
613# a <1> rv2av[t1] lKRM*/1
9e84f099 614# b <2> aassign[t3] KS/COMMON
cc02ea56 615# c <1> leavesub[1 ref] K/REFC,1
616EONT_EONT
617
618
619=for gentest
620
621# chunk: # repeat, condensed. $main::a and $b are unaffected
622sub other::backwards ($$) { $_[1] cmp $_[0]; }
623@new = sort other::backwards @old;
624
625=cut
626
627checkOptree(note => q{},
628 bcopts => q{-exec},
629 code => q{sub other::backwards ($$) { $_[1] cmp $_[0]; } @new = sort other::backwards @old; },
630 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
631# 1 <;> nextstate(main 619 (eval 38):1) v
632# 2 <0> pushmark s
633# 3 <0> pushmark s
634# 4 <$> const[PV "other::backwards"] s/BARE
635# 5 <#> gv[*old] s
636# 6 <1> rv2av[t4] lK/1
637# 7 <@> sort lKS
638# 8 <0> pushmark s
639# 9 <#> gv[*new] s
640# a <1> rv2av[t2] lKRM*/1
9e84f099 641# b <2> aassign[t5] KS/COMMON
cc02ea56 642# c <1> leavesub[1 ref] K/REFC,1
643EOT_EOT
644# 1 <;> nextstate(main 546 (eval 15):1) v
645# 2 <0> pushmark s
646# 3 <0> pushmark s
647# 4 <$> const(PV "other::backwards") s/BARE
648# 5 <$> gv(*old) s
649# 6 <1> rv2av[t2] lK/1
650# 7 <@> sort lKS
651# 8 <0> pushmark s
652# 9 <$> gv(*new) s
653# a <1> rv2av[t1] lKRM*/1
9e84f099 654# b <2> aassign[t3] KS/COMMON
cc02ea56 655# c <1> leavesub[1 ref] K/REFC,1
656EONT_EONT
657
658
659=for gentest
660
661# chunk: # guarantee stability, regardless of algorithm
662use sort 'stable';
663@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
664
665=cut
666
667checkOptree(note => q{},
668 bcopts => q{-exec},
669 code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
670 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 671# 1 <;> nextstate(main 656 (eval 40):1) v:%,{
cc02ea56 672# 2 <0> pushmark s
673# 3 <0> pushmark s
674# 4 <#> gv[*old] s
675# 5 <1> rv2av[t9] lK/1
7b9ef140 676# 6 <@> sort lKS*/STABLE
cc02ea56 677# 7 <0> pushmark s
678# 8 <#> gv[*new] s
679# 9 <1> rv2av[t2] lKRM*/1
9e84f099 680# a <2> aassign[t14] KS/COMMON
cc02ea56 681# b <1> leavesub[1 ref] K/REFC,1
682EOT_EOT
d5ec2987 683# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56 684# 2 <0> pushmark s
685# 3 <0> pushmark s
686# 4 <$> gv(*old) s
687# 5 <1> rv2av[t5] lK/1
7b9ef140 688# 6 <@> sort lKS*/STABLE
cc02ea56 689# 7 <0> pushmark s
690# 8 <$> gv(*new) s
691# 9 <1> rv2av[t1] lKRM*/1
9e84f099 692# a <2> aassign[t6] KS/COMMON
cc02ea56 693# b <1> leavesub[1 ref] K/REFC,1
694EONT_EONT
695
696
697=for gentest
698
699# chunk: # force use of mergesort (not portable outside Perl 5.8)
700use sort '_mergesort';
701@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
702
703=cut
704
705checkOptree(note => q{},
706 bcopts => q{-exec},
707 code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
708 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 709# 1 <;> nextstate(main 662 (eval 42):1) v:%,{
cc02ea56 710# 2 <0> pushmark s
711# 3 <0> pushmark s
712# 4 <#> gv[*old] s
713# 5 <1> rv2av[t9] lK/1
714# 6 <@> sort lKS*
715# 7 <0> pushmark s
716# 8 <#> gv[*new] s
717# 9 <1> rv2av[t2] lKRM*/1
9e84f099 718# a <2> aassign[t14] KS/COMMON
cc02ea56 719# b <1> leavesub[1 ref] K/REFC,1
720EOT_EOT
d5ec2987 721# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56 722# 2 <0> pushmark s
723# 3 <0> pushmark s
724# 4 <$> gv(*old) s
725# 5 <1> rv2av[t5] lK/1
726# 6 <@> sort lKS*
727# 7 <0> pushmark s
728# 8 <$> gv(*new) s
729# 9 <1> rv2av[t1] lKRM*/1
9e84f099 730# a <2> aassign[t6] KS/COMMON
cc02ea56 731# b <1> leavesub[1 ref] K/REFC,1
732EONT_EONT
733
734
735=for gentest
736
737# chunk: # you should have a good reason to do this!
738@articles = sort {$FooPack::b <=> $FooPack::a} @files;
739
740=cut
741
742checkOptree(note => q{},
743 bcopts => q{-exec},
744 code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
745 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
746# 1 <;> nextstate(main 667 (eval 44):1) v
747# 2 <0> pushmark s
748# 3 <0> pushmark s
749# 4 <#> gv[*files] s
750# 5 <1> rv2av[t7] lK/1
751# 6 <@> sort lKS*
752# 7 <0> pushmark s
753# 8 <#> gv[*articles] s
754# 9 <1> rv2av[t2] lKRM*/1
9e84f099 755# a <2> aassign[t8] KS/COMMON
cc02ea56 756# b <1> leavesub[1 ref] K/REFC,1
757EOT_EOT
758# 1 <;> nextstate(main 546 (eval 15):1) v
759# 2 <0> pushmark s
760# 3 <0> pushmark s
761# 4 <$> gv(*files) s
762# 5 <1> rv2av[t3] lK/1
763# 6 <@> sort lKS*
764# 7 <0> pushmark s
765# 8 <$> gv(*articles) s
766# 9 <1> rv2av[t1] lKRM*/1
9e84f099 767# a <2> aassign[t4] KS/COMMON
cc02ea56 768# b <1> leavesub[1 ref] K/REFC,1
769EONT_EONT
770
771
772=for gentest
773
774# chunk: # fancy
775@result = sort { $a <=> $b } grep { $_ == $_ } @input;
776
777=cut
778
779checkOptree(note => q{},
780 bcopts => q{-exec},
781 code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
782 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
783# 1 <;> nextstate(main 673 (eval 46):1) v
784# 2 <0> pushmark s
785# 3 <0> pushmark s
786# 4 <0> pushmark s
787# 5 <#> gv[*input] s
788# 6 <1> rv2av[t9] lKM/1
789# 7 <@> grepstart lK*
790# 8 <|> grepwhile(other->9)[t10] lK
791# 9 <#> gvsv[*_] s
792# a <#> gvsv[*_] s
793# b <2> eq sK/2
794# - <@> scope sK
795# goto 8
796# c <@> sort lK/NUM
797# d <0> pushmark s
798# e <#> gv[*result] s
799# f <1> rv2av[t2] lKRM*/1
9ad9869c 800# g <2> aassign[t3] KS/COMMON
cc02ea56 801# h <1> leavesub[1 ref] K/REFC,1
802EOT_EOT
803# 1 <;> nextstate(main 547 (eval 15):1) v
804# 2 <0> pushmark s
805# 3 <0> pushmark s
806# 4 <0> pushmark s
807# 5 <$> gv(*input) s
808# 6 <1> rv2av[t3] lKM/1
809# 7 <@> grepstart lK*
810# 8 <|> grepwhile(other->9)[t4] lK
811# 9 <$> gvsv(*_) s
812# a <$> gvsv(*_) s
813# b <2> eq sK/2
814# - <@> scope sK
815# goto 8
816# c <@> sort lK/NUM
817# d <0> pushmark s
818# e <$> gv(*result) s
819# f <1> rv2av[t1] lKRM*/1
820# g <2> aassign[t2] KS/COMMON
821# h <1> leavesub[1 ref] K/REFC,1
822EONT_EONT
823
824
825=for gentest
826
827# chunk: # void return context sort
828sort { $a <=> $b } @input;
829
830=cut
831
832checkOptree(note => q{},
833 bcopts => q{-exec},
834 code => q{sort { $a <=> $b } @input; },
835 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
836# 1 <;> nextstate(main 678 (eval 48):1) v
837# 2 <0> pushmark s
838# 3 <#> gv[*input] s
839# 4 <1> rv2av[t5] lK/1
840# 5 <@> sort K/NUM
841# 6 <1> leavesub[1 ref] K/REFC,1
842EOT_EOT
843# 1 <;> nextstate(main 546 (eval 15):1) v
844# 2 <0> pushmark s
845# 3 <$> gv(*input) s
846# 4 <1> rv2av[t2] lK/1
847# 5 <@> sort K/NUM
848# 6 <1> leavesub[1 ref] K/REFC,1
849EONT_EONT
850
851
852=for gentest
853
854# chunk: # more void context, propagating ?
855sort { $a <=> $b } grep { $_ == $_ } @input;
856
857=cut
858
859checkOptree(note => q{},
860 bcopts => q{-exec},
861 code => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
862 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
863# 1 <;> nextstate(main 684 (eval 50):1) v
864# 2 <0> pushmark s
865# 3 <0> pushmark s
866# 4 <#> gv[*input] s
867# 5 <1> rv2av[t7] lKM/1
868# 6 <@> grepstart lK*
869# 7 <|> grepwhile(other->8)[t8] lK
870# 8 <#> gvsv[*_] s
871# 9 <#> gvsv[*_] s
872# a <2> eq sK/2
873# - <@> scope sK
874# goto 7
875# b <@> sort K/NUM
876# c <1> leavesub[1 ref] K/REFC,1
877EOT_EOT
878# 1 <;> nextstate(main 547 (eval 15):1) v
879# 2 <0> pushmark s
880# 3 <0> pushmark s
881# 4 <$> gv(*input) s
882# 5 <1> rv2av[t2] lKM/1
883# 6 <@> grepstart lK*
884# 7 <|> grepwhile(other->8)[t3] lK
885# 8 <$> gvsv(*_) s
886# 9 <$> gvsv(*_) s
887# a <2> eq sK/2
888# - <@> scope sK
889# goto 7
890# b <@> sort K/NUM
891# c <1> leavesub[1 ref] K/REFC,1
892EONT_EONT
893
894
895=for gentest
896
897# chunk: # scalar return context sort
898$s = sort { $a <=> $b } @input;
899
900=cut
901
902checkOptree(note => q{},
903 bcopts => q{-exec},
904 code => q{$s = sort { $a <=> $b } @input; },
905 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 906# 1 <;> nextstate(main 689 (eval 52):1) v:{
cc02ea56 907# 2 <0> pushmark s
908# 3 <#> gv[*input] s
909# 4 <1> rv2av[t6] lK/1
910# 5 <@> sort sK/NUM
911# 6 <#> gvsv[*s] s
912# 7 <2> sassign sKS/2
913# 8 <1> leavesub[1 ref] K/REFC,1
914EOT_EOT
d5ec2987 915# 1 <;> nextstate(main 546 (eval 15):1) v:{
cc02ea56 916# 2 <0> pushmark s
917# 3 <$> gv(*input) s
918# 4 <1> rv2av[t2] lK/1
919# 5 <@> sort sK/NUM
920# 6 <$> gvsv(*s) s
921# 7 <2> sassign sKS/2
922# 8 <1> leavesub[1 ref] K/REFC,1
923EONT_EONT
924
925
926=for gentest
927
928# chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
929
930=cut
931
932checkOptree(note => q{},
933 bcopts => q{-exec},
934 code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
935 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 936# 1 <;> nextstate(main 695 (eval 54):1) v:{
cc02ea56 937# 2 <0> pushmark s
938# 3 <0> pushmark s
939# 4 <#> gv[*input] s
940# 5 <1> rv2av[t8] lKM/1
941# 6 <@> grepstart lK*
942# 7 <|> grepwhile(other->8)[t9] lK
943# 8 <#> gvsv[*_] s
944# 9 <#> gvsv[*_] s
945# a <2> eq sK/2
946# - <@> scope sK
947# goto 7
948# b <@> sort sK/NUM
949# c <#> gvsv[*s] s
950# d <2> sassign sKS/2
951# e <1> leavesub[1 ref] K/REFC,1
952EOT_EOT
d5ec2987 953# 1 <;> nextstate(main 547 (eval 15):1) v:{
cc02ea56 954# 2 <0> pushmark s
955# 3 <0> pushmark s
956# 4 <$> gv(*input) s
957# 5 <1> rv2av[t2] lKM/1
958# 6 <@> grepstart lK*
959# 7 <|> grepwhile(other->8)[t3] lK
960# 8 <$> gvsv(*_) s
961# 9 <$> gvsv(*_) s
962# a <2> eq sK/2
963# - <@> scope sK
964# goto 7
965# b <@> sort sK/NUM
966# c <$> gvsv(*s) s
967# d <2> sassign sKS/2
968# e <1> leavesub[1 ref] K/REFC,1
969EONT_EONT
970
Unnamed repository; edit this file to name it for gitweb.