projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to Win32API-File 0.1101
[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
e412117e 667my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d5ec2987 668# 1 <;> nextstate(main 656 (eval 40):1) v:%,{
cc02ea56 669# 2 <0> pushmark s
670# 3 <0> pushmark s
671# 4 <#> gv[*old] s
672# 5 <1> rv2av[t9] lK/1
7b9ef140 673# 6 <@> sort lKS*/STABLE
cc02ea56 674# 7 <0> pushmark s
675# 8 <#> gv[*new] s
676# 9 <1> rv2av[t2] lKRM*/1
9e84f099 677# a <2> aassign[t14] KS/COMMON
cc02ea56 678# b <1> leavesub[1 ref] K/REFC,1
679EOT_EOT
d5ec2987 680# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56 681# 2 <0> pushmark s
682# 3 <0> pushmark s
683# 4 <$> gv(*old) s
684# 5 <1> rv2av[t5] lK/1
7b9ef140 685# 6 <@> sort lKS*/STABLE
cc02ea56 686# 7 <0> pushmark s
687# 8 <$> gv(*new) s
688# 9 <1> rv2av[t1] lKRM*/1
9e84f099 689# a <2> aassign[t6] KS/COMMON
cc02ea56 690# b <1> leavesub[1 ref] K/REFC,1
691EONT_EONT
e412117e 692
693if($] < 5.009) {
694 # 5.8.x doesn't show the /STABLE flag, so massage the golden results.
695 s!/STABLE!!s foreach ($expect, $expect_nt);
696}
697
698checkOptree(note => q{},
699 bcopts => q{-exec},
700 code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
701 expect => $expect, expect_nt => $expect_nt);
cc02ea56 702
703=for gentest
704
705# chunk: # force use of mergesort (not portable outside Perl 5.8)
706use sort '_mergesort';
707@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
708
709=cut
710
711checkOptree(note => q{},
712 bcopts => q{-exec},
713 code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
714 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 715# 1 <;> nextstate(main 662 (eval 42):1) v:%,{
cc02ea56 716# 2 <0> pushmark s
717# 3 <0> pushmark s
718# 4 <#> gv[*old] s
719# 5 <1> rv2av[t9] lK/1
720# 6 <@> sort lKS*
721# 7 <0> pushmark s
722# 8 <#> gv[*new] s
723# 9 <1> rv2av[t2] lKRM*/1
9e84f099 724# a <2> aassign[t14] KS/COMMON
cc02ea56 725# b <1> leavesub[1 ref] K/REFC,1
726EOT_EOT
d5ec2987 727# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
cc02ea56 728# 2 <0> pushmark s
729# 3 <0> pushmark s
730# 4 <$> gv(*old) s
731# 5 <1> rv2av[t5] lK/1
732# 6 <@> sort lKS*
733# 7 <0> pushmark s
734# 8 <$> gv(*new) s
735# 9 <1> rv2av[t1] lKRM*/1
9e84f099 736# a <2> aassign[t6] KS/COMMON
cc02ea56 737# b <1> leavesub[1 ref] K/REFC,1
738EONT_EONT
739
740
741=for gentest
742
743# chunk: # you should have a good reason to do this!
744@articles = sort {$FooPack::b <=> $FooPack::a} @files;
745
746=cut
747
748checkOptree(note => q{},
749 bcopts => q{-exec},
750 code => q{@articles = sort {$FooPack::b <=> $FooPack::a} @files; },
751 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
752# 1 <;> nextstate(main 667 (eval 44):1) v
753# 2 <0> pushmark s
754# 3 <0> pushmark s
755# 4 <#> gv[*files] s
756# 5 <1> rv2av[t7] lK/1
757# 6 <@> sort lKS*
758# 7 <0> pushmark s
759# 8 <#> gv[*articles] s
760# 9 <1> rv2av[t2] lKRM*/1
9e84f099 761# a <2> aassign[t8] KS/COMMON
cc02ea56 762# b <1> leavesub[1 ref] K/REFC,1
763EOT_EOT
764# 1 <;> nextstate(main 546 (eval 15):1) v
765# 2 <0> pushmark s
766# 3 <0> pushmark s
767# 4 <$> gv(*files) s
768# 5 <1> rv2av[t3] lK/1
769# 6 <@> sort lKS*
770# 7 <0> pushmark s
771# 8 <$> gv(*articles) s
772# 9 <1> rv2av[t1] lKRM*/1
9e84f099 773# a <2> aassign[t4] KS/COMMON
cc02ea56 774# b <1> leavesub[1 ref] K/REFC,1
775EONT_EONT
776
777
778=for gentest
779
780# chunk: # fancy
781@result = sort { $a <=> $b } grep { $_ == $_ } @input;
782
783=cut
784
785checkOptree(note => q{},
786 bcopts => q{-exec},
787 code => q{@result = sort { $a <=> $b } grep { $_ == $_ } @input; },
788 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
789# 1 <;> nextstate(main 673 (eval 46):1) v
790# 2 <0> pushmark s
791# 3 <0> pushmark s
792# 4 <0> pushmark s
793# 5 <#> gv[*input] s
794# 6 <1> rv2av[t9] lKM/1
795# 7 <@> grepstart lK*
796# 8 <|> grepwhile(other->9)[t10] lK
797# 9 <#> gvsv[*_] s
798# a <#> gvsv[*_] s
799# b <2> eq sK/2
800# - <@> scope sK
801# goto 8
802# c <@> sort lK/NUM
803# d <0> pushmark s
804# e <#> gv[*result] s
805# f <1> rv2av[t2] lKRM*/1
9ad9869c 806# g <2> aassign[t3] KS/COMMON
cc02ea56 807# h <1> leavesub[1 ref] K/REFC,1
808EOT_EOT
809# 1 <;> nextstate(main 547 (eval 15):1) v
810# 2 <0> pushmark s
811# 3 <0> pushmark s
812# 4 <0> pushmark s
813# 5 <$> gv(*input) s
814# 6 <1> rv2av[t3] lKM/1
815# 7 <@> grepstart lK*
816# 8 <|> grepwhile(other->9)[t4] lK
817# 9 <$> gvsv(*_) s
818# a <$> gvsv(*_) s
819# b <2> eq sK/2
820# - <@> scope sK
821# goto 8
822# c <@> sort lK/NUM
823# d <0> pushmark s
824# e <$> gv(*result) s
825# f <1> rv2av[t1] lKRM*/1
826# g <2> aassign[t2] KS/COMMON
827# h <1> leavesub[1 ref] K/REFC,1
828EONT_EONT
829
830
831=for gentest
832
833# chunk: # void return context sort
834sort { $a <=> $b } @input;
835
836=cut
837
838checkOptree(note => q{},
839 bcopts => q{-exec},
840 code => q{sort { $a <=> $b } @input; },
841 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
842# 1 <;> nextstate(main 678 (eval 48):1) v
843# 2 <0> pushmark s
844# 3 <#> gv[*input] s
845# 4 <1> rv2av[t5] lK/1
846# 5 <@> sort K/NUM
847# 6 <1> leavesub[1 ref] K/REFC,1
848EOT_EOT
849# 1 <;> nextstate(main 546 (eval 15):1) v
850# 2 <0> pushmark s
851# 3 <$> gv(*input) s
852# 4 <1> rv2av[t2] lK/1
853# 5 <@> sort K/NUM
854# 6 <1> leavesub[1 ref] K/REFC,1
855EONT_EONT
856
857
858=for gentest
859
860# chunk: # more void context, propagating ?
861sort { $a <=> $b } grep { $_ == $_ } @input;
862
863=cut
864
865checkOptree(note => q{},
866 bcopts => q{-exec},
867 code => q{sort { $a <=> $b } grep { $_ == $_ } @input; },
868 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
869# 1 <;> nextstate(main 684 (eval 50):1) v
870# 2 <0> pushmark s
871# 3 <0> pushmark s
872# 4 <#> gv[*input] s
873# 5 <1> rv2av[t7] lKM/1
874# 6 <@> grepstart lK*
875# 7 <|> grepwhile(other->8)[t8] lK
876# 8 <#> gvsv[*_] s
877# 9 <#> gvsv[*_] s
878# a <2> eq sK/2
879# - <@> scope sK
880# goto 7
881# b <@> sort K/NUM
882# c <1> leavesub[1 ref] K/REFC,1
883EOT_EOT
884# 1 <;> nextstate(main 547 (eval 15):1) v
885# 2 <0> pushmark s
886# 3 <0> pushmark s
887# 4 <$> gv(*input) s
888# 5 <1> rv2av[t2] lKM/1
889# 6 <@> grepstart lK*
890# 7 <|> grepwhile(other->8)[t3] lK
891# 8 <$> gvsv(*_) s
892# 9 <$> gvsv(*_) s
893# a <2> eq sK/2
894# - <@> scope sK
895# goto 7
896# b <@> sort K/NUM
897# c <1> leavesub[1 ref] K/REFC,1
898EONT_EONT
899
900
901=for gentest
902
903# chunk: # scalar return context sort
904$s = sort { $a <=> $b } @input;
905
906=cut
907
908checkOptree(note => q{},
909 bcopts => q{-exec},
910 code => q{$s = sort { $a <=> $b } @input; },
911 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 912# 1 <;> nextstate(main 689 (eval 52):1) v:{
cc02ea56 913# 2 <0> pushmark s
914# 3 <#> gv[*input] s
915# 4 <1> rv2av[t6] lK/1
916# 5 <@> sort sK/NUM
917# 6 <#> gvsv[*s] s
918# 7 <2> sassign sKS/2
919# 8 <1> leavesub[1 ref] K/REFC,1
920EOT_EOT
d5ec2987 921# 1 <;> nextstate(main 546 (eval 15):1) v:{
cc02ea56 922# 2 <0> pushmark s
923# 3 <$> gv(*input) s
924# 4 <1> rv2av[t2] lK/1
925# 5 <@> sort sK/NUM
926# 6 <$> gvsv(*s) s
927# 7 <2> sassign sKS/2
928# 8 <1> leavesub[1 ref] K/REFC,1
929EONT_EONT
930
931
932=for gentest
933
934# chunk: $s = sort { $a <=> $b } grep { $_ == $_ } @input;
935
936=cut
937
938checkOptree(note => q{},
939 bcopts => q{-exec},
940 code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
941 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 942# 1 <;> nextstate(main 695 (eval 54):1) v:{
cc02ea56 943# 2 <0> pushmark s
944# 3 <0> pushmark s
945# 4 <#> gv[*input] s
946# 5 <1> rv2av[t8] lKM/1
947# 6 <@> grepstart lK*
948# 7 <|> grepwhile(other->8)[t9] lK
949# 8 <#> gvsv[*_] s
950# 9 <#> gvsv[*_] s
951# a <2> eq sK/2
952# - <@> scope sK
953# goto 7
954# b <@> sort sK/NUM
955# c <#> gvsv[*s] s
956# d <2> sassign sKS/2
957# e <1> leavesub[1 ref] K/REFC,1
958EOT_EOT
d5ec2987 959# 1 <;> nextstate(main 547 (eval 15):1) v:{
cc02ea56 960# 2 <0> pushmark s
961# 3 <0> pushmark s
962# 4 <$> gv(*input) s
963# 5 <1> rv2av[t2] lKM/1
964# 6 <@> grepstart lK*
965# 7 <|> grepwhile(other->8)[t3] lK
966# 8 <$> gvsv(*_) s
967# 9 <$> gvsv(*_) s
968# a <2> eq sK/2
969# - <@> scope sK
970# goto 7
971# b <@> sort sK/NUM
972# c <$> gvsv(*s) s
973# d <2> sassign sKS/2
974# e <1> leavesub[1 ref] K/REFC,1
975EONT_EONT
976
Unnamed repository; edit this file to name it for gitweb.