libperl leaks a THREAD_KEY each time it is reloaded
[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 }
8dd2f9d4 20 if ($Config::Config{'extensions'} !~ /\bData\/Dumper\b/) {
2799c206 21 print
22 "1..0 # Skip: Data::Dumper was not built, needed by OptreeCheck\n";
23 exit 0;
2799c206 24 }
7252851f 25 if ($] < 5.009) {
26 print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n";
27 exit 0;
28 }
5638aaac 29 require q(test.pl);
cc02ea56 30}
31use OptreeCheck;
32plan tests => 20;
33
34
7ce9b5fb 35=head1 Test Notes
cc02ea56 36
37# chunk: #!perl
38#examples poached from perldoc -f sort
39
7ce9b5fb 40NOTE: name is no longer a required arg for checkOptree, as label is
41synthesized out of others. HOWEVER, if the test-code has newlines in
42it, the label must be overridden by an explicit name.
43
44This is because t/TEST is quite particular about the test output it
45processes, and multi-line labels violate its 1-line-per-test
46expectations.
47
cc02ea56 48=for gentest
49
50# chunk: # sort lexically
51@articles = sort @files;
52
53=cut
54
55checkOptree(note => q{},
56 bcopts => q{-exec},
57 code => q{@articles = sort @files; },
58 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
59# 1 <;> nextstate(main 545 (eval 15):1) v
60# 2 <0> pushmark s
61# 3 <0> pushmark s
62# 4 <#> gv[*files] s
63# 5 <1> rv2av[t4] lK/1
64# 6 <@> sort lK
65# 7 <0> pushmark s
66# 8 <#> gv[*articles] s
67# 9 <1> rv2av[t2] lKRM*/1
68# a <2> aassign[t5] KS
69# b <1> leavesub[1 ref] K/REFC,1
70EOT_EOT
71# 1 <;> nextstate(main 545 (eval 15):1) v
72# 2 <0> pushmark s
73# 3 <0> pushmark s
74# 4 <$> gv(*files) s
75# 5 <1> rv2av[t2] lK/1
76# 6 <@> sort lK
77# 7 <0> pushmark s
78# 8 <$> gv(*articles) s
79# 9 <1> rv2av[t1] lKRM*/1
80# a <2> aassign[t3] KS
81# b <1> leavesub[1 ref] K/REFC,1
82EONT_EONT
83
84
85=for gentest
86
87# chunk: # same thing, but with explicit sort routine
88@articles = sort {$a cmp $b} @files;
89
90=cut
91
92checkOptree(note => q{},
93 bcopts => q{-exec},
94 code => q{@articles = sort {$a cmp $b} @files; },
95 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
96# 1 <;> nextstate(main 546 (eval 15):1) v
97# 2 <0> pushmark s
98# 3 <0> pushmark s
99# 4 <#> gv[*files] s
100# 5 <1> rv2av[t7] lK/1
101# 6 <@> sort lK
102# 7 <0> pushmark s
103# 8 <#> gv[*articles] s
104# 9 <1> rv2av[t2] lKRM*/1
105# a <2> aassign[t5] KS
106# b <1> leavesub[1 ref] K/REFC,1
107EOT_EOT
108# 1 <;> nextstate(main 546 (eval 15):1) v
109# 2 <0> pushmark s
110# 3 <0> pushmark s
111# 4 <$> gv(*files) s
112# 5 <1> rv2av[t3] lK/1
113# 6 <@> sort lK
114# 7 <0> pushmark s
115# 8 <$> gv(*articles) s
116# 9 <1> rv2av[t1] lKRM*/1
117# a <2> aassign[t2] KS
118# b <1> leavesub[1 ref] K/REFC,1
119EONT_EONT
120
121
122=for gentest
123
124# chunk: # now case-insensitively
125@articles = sort {uc($a) cmp uc($b)} @files;
126
127=cut
128
129checkOptree(note => q{},
130 bcopts => q{-exec},
131 code => q{@articles = sort {uc($a) cmp uc($b)} @files; },
132 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
133# 1 <;> nextstate(main 546 (eval 15):1) v
134# 2 <0> pushmark s
135# 3 <0> pushmark s
136# 4 <#> gv[*files] s
137# 5 <1> rv2av[t9] lK/1
138# 6 <@> sort lKS*
139# 7 <0> pushmark s
140# 8 <#> gv[*articles] s
141# 9 <1> rv2av[t2] lKRM*/1
142# a <2> aassign[t10] KS
143# b <1> leavesub[1 ref] K/REFC,1
144EOT_EOT
145# 1 <;> nextstate(main 546 (eval 15):1) v
146# 2 <0> pushmark s
147# 3 <0> pushmark s
148# 4 <$> gv(*files) s
149# 5 <1> rv2av[t5] lK/1
150# 6 <@> sort lKS*
151# 7 <0> pushmark s
152# 8 <$> gv(*articles) s
153# 9 <1> rv2av[t1] lKRM*/1
154# a <2> aassign[t6] KS
155# b <1> leavesub[1 ref] K/REFC,1
156EONT_EONT
157
158
159=for gentest
160
161# chunk: # same thing in reversed order
162@articles = sort {$b cmp $a} @files;
163
164=cut
165
166checkOptree(note => q{},
167 bcopts => q{-exec},
168 code => q{@articles = sort {$b cmp $a} @files; },
169 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
170# 1 <;> nextstate(main 546 (eval 15):1) v
171# 2 <0> pushmark s
172# 3 <0> pushmark s
173# 4 <#> gv[*files] s
174# 5 <1> rv2av[t7] lK/1
6c3fb703 175# 6 <@> sort lK/DESC
cc02ea56 176# 7 <0> pushmark s
177# 8 <#> gv[*articles] s
178# 9 <1> rv2av[t2] lKRM*/1
6c3fb703 179# a <2> aassign[t5] KS
cc02ea56 180# b <1> leavesub[1 ref] K/REFC,1
181EOT_EOT
182# 1 <;> nextstate(main 546 (eval 15):1) v
183# 2 <0> pushmark s
184# 3 <0> pushmark s
185# 4 <$> gv(*files) s
186# 5 <1> rv2av[t3] lK/1
6c3fb703 187# 6 <@> sort lK/DESC
cc02ea56 188# 7 <0> pushmark s
189# 8 <$> gv(*articles) s
190# 9 <1> rv2av[t1] lKRM*/1
6c3fb703 191# a <2> aassign[t2] KS
cc02ea56 192# b <1> leavesub[1 ref] K/REFC,1
193EONT_EONT
194
195
196=for gentest
197
198# chunk: # sort numerically ascending
199@articles = sort {$a <=> $b} @files;
200
201=cut
202
203checkOptree(note => q{},
204 bcopts => q{-exec},
205 code => q{@articles = sort {$a <=> $b} @files; },
206 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
207# 1 <;> nextstate(main 546 (eval 15):1) v
208# 2 <0> pushmark s
209# 3 <0> pushmark s
210# 4 <#> gv[*files] s
211# 5 <1> rv2av[t7] lK/1
212# 6 <@> sort lK/NUM
213# 7 <0> pushmark s
214# 8 <#> gv[*articles] s
215# 9 <1> rv2av[t2] lKRM*/1
216# a <2> aassign[t5] KS
217# b <1> leavesub[1 ref] K/REFC,1
218EOT_EOT
219# 1 <;> nextstate(main 546 (eval 15):1) v
220# 2 <0> pushmark s
221# 3 <0> pushmark s
222# 4 <$> gv(*files) s
223# 5 <1> rv2av[t3] lK/1
224# 6 <@> sort lK/NUM
225# 7 <0> pushmark s
226# 8 <$> gv(*articles) s
227# 9 <1> rv2av[t1] lKRM*/1
228# a <2> aassign[t2] KS
229# b <1> leavesub[1 ref] K/REFC,1
230EONT_EONT
231
232
233=for gentest
234
235# chunk: # sort numerically descending
236@articles = sort {$b <=> $a} @files;
237
238=cut
239
240checkOptree(note => q{},
241 bcopts => q{-exec},
242 code => q{@articles = sort {$b <=> $a} @files; },
243 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
244# 1 <;> nextstate(main 587 (eval 26):1) v
245# 2 <0> pushmark s
246# 3 <0> pushmark s
247# 4 <#> gv[*files] s
248# 5 <1> rv2av[t7] lK/1
6c3fb703 249# 6 <@> sort lK/DESC,NUM
cc02ea56 250# 7 <0> pushmark s
251# 8 <#> gv[*articles] s
252# 9 <1> rv2av[t2] lKRM*/1
6c3fb703 253# a <2> aassign[t5] KS
cc02ea56 254# b <1> leavesub[1 ref] K/REFC,1
255EOT_EOT
256# 1 <;> nextstate(main 546 (eval 15):1) v
257# 2 <0> pushmark s
258# 3 <0> pushmark s
259# 4 <$> gv(*files) s
260# 5 <1> rv2av[t3] lK/1
6c3fb703 261# 6 <@> sort lK/DESC,NUM
cc02ea56 262# 7 <0> pushmark s
263# 8 <$> gv(*articles) s
264# 9 <1> rv2av[t1] lKRM*/1
6c3fb703 265# a <2> aassign[t2] KS
cc02ea56 266# b <1> leavesub[1 ref] K/REFC,1
267EONT_EONT
268
269
270=for gentest
271
272# chunk: # this sorts the %age hash by value instead of key
273# using an in-line function
274@eldest = sort { $age{$b} <=> $age{$a} } keys %age;
275
276=cut
277
278checkOptree(note => q{},
279 bcopts => q{-exec},
280 code => q{@eldest = sort { $age{$b} <=> $age{$a} } keys %age; },
281 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
282# 1 <;> nextstate(main 592 (eval 28):1) v
283# 2 <0> pushmark s
284# 3 <0> pushmark s
285# 4 <#> gv[*age] s
286# 5 <1> rv2hv[t9] lKRM/1
287# 6 <1> keys[t10] lK/1
288# 7 <@> sort lKS*
289# 8 <0> pushmark s
290# 9 <#> gv[*eldest] s
291# a <1> rv2av[t2] lKRM*/1
292# b <2> aassign[t11] KS
293# c <1> leavesub[1 ref] K/REFC,1
294EOT_EOT
295# 1 <;> nextstate(main 546 (eval 15):1) v
296# 2 <0> pushmark s
297# 3 <0> pushmark s
298# 4 <$> gv(*age) s
299# 5 <1> rv2hv[t3] lKRM/1
300# 6 <1> keys[t4] lK/1
301# 7 <@> sort lKS*
302# 8 <0> pushmark s
303# 9 <$> gv(*eldest) s
304# a <1> rv2av[t1] lKRM*/1
305# b <2> aassign[t5] KS
306# c <1> leavesub[1 ref] K/REFC,1
307EONT_EONT
308
309
310=for gentest
311
312# chunk: # sort using explicit subroutine name
313sub byage {
314 $age{$a} <=> $age{$b}; # presuming numeric
315}
316@sortedclass = sort byage @class;
317
318=cut
319
320checkOptree(note => q{},
321 bcopts => q{-exec},
322 code => q{sub byage { $age{$a} <=> $age{$b}; } @sortedclass = sort byage @class; },
323 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
324# 1 <;> nextstate(main 597 (eval 30):1) v
325# 2 <0> pushmark s
326# 3 <0> pushmark s
327# 4 <$> const[PV "byage"] s/BARE
328# 5 <#> gv[*class] s
329# 6 <1> rv2av[t4] lK/1
330# 7 <@> sort lKS
331# 8 <0> pushmark s
332# 9 <#> gv[*sortedclass] s
333# a <1> rv2av[t2] lKRM*/1
334# b <2> aassign[t5] KS
335# c <1> leavesub[1 ref] K/REFC,1
336EOT_EOT
337# 1 <;> nextstate(main 546 (eval 15):1) v
338# 2 <0> pushmark s
339# 3 <0> pushmark s
340# 4 <$> const(PV "byage") s/BARE
341# 5 <$> gv(*class) s
342# 6 <1> rv2av[t2] lK/1
343# 7 <@> sort lKS
344# 8 <0> pushmark s
345# 9 <$> gv(*sortedclass) s
346# a <1> rv2av[t1] lKRM*/1
347# b <2> aassign[t3] KS
348# c <1> leavesub[1 ref] K/REFC,1
349EONT_EONT
350
351
352=for gentest
353
354# chunk: sub backwards { $b cmp $a }
355@harry = qw(dog cat x Cain Abel);
356@george = qw(gone chased yz Punished Axed);
357print sort @harry;
358# prints AbelCaincatdogx
359print sort backwards @harry;
360# prints xdogcatCainAbel
361print sort @george, 'to', @harry;
362# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
363
364=cut
365
7ce9b5fb 366checkOptree(name => q{sort USERSUB LIST },
cc02ea56 367 bcopts => q{-exec},
cc02ea56 368 code => q{sub backwards { $b cmp $a }
369 @harry = qw(dog cat x Cain Abel);
370 @george = qw(gone chased yz Punished Axed);
371 print sort @harry; print sort backwards @harry;
372 print sort @george, 'to', @harry; },
373 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
374# 1 <;> nextstate(main 602 (eval 32):2) v
375# 2 <0> pushmark s
376# 3 <$> const[PV "dog"] s
377# 4 <$> const[PV "cat"] s
378# 5 <$> const[PV "x"] s
379# 6 <$> const[PV "Cain"] s
380# 7 <$> const[PV "Abel"] s
381# 8 <0> pushmark s
382# 9 <#> gv[*harry] s
383# a <1> rv2av[t2] lKRM*/1
384# b <2> aassign[t3] vKS
385# c <;> nextstate(main 602 (eval 32):3) v
386# d <0> pushmark s
387# e <$> const[PV "gone"] s
388# f <$> const[PV "chased"] s
389# g <$> const[PV "yz"] s
390# h <$> const[PV "Punished"] s
391# i <$> const[PV "Axed"] s
392# j <0> pushmark s
393# k <#> gv[*george] s
394# l <1> rv2av[t5] lKRM*/1
395# m <2> aassign[t6] vKS
396# n <;> nextstate(main 602 (eval 32):4) v
397# o <0> pushmark s
398# p <0> pushmark s
399# q <#> gv[*harry] s
400# r <1> rv2av[t8] lK/1
401# s <@> sort lK
402# t <@> print vK
403# u <;> nextstate(main 602 (eval 32):4) v
404# v <0> pushmark s
405# w <0> pushmark s
406# x <$> const[PV "backwards"] s/BARE
407# y <#> gv[*harry] s
408# z <1> rv2av[t10] lK/1
409# 10 <@> sort lKS
410# 11 <@> print vK
411# 12 <;> nextstate(main 602 (eval 32):5) v
412# 13 <0> pushmark s
413# 14 <0> pushmark s
414# 15 <#> gv[*george] s
415# 16 <1> rv2av[t12] lK/1
416# 17 <$> const[PV "to"] s
417# 18 <#> gv[*harry] s
418# 19 <1> rv2av[t14] lK/1
419# 1a <@> sort lK
420# 1b <@> print sK
421# 1c <1> leavesub[1 ref] K/REFC,1
422EOT_EOT
423# 1 <;> nextstate(main 602 (eval 32):2) v
424# 2 <0> pushmark s
425# 3 <$> const(PV "dog") s
426# 4 <$> const(PV "cat") s
427# 5 <$> const(PV "x") s
428# 6 <$> const(PV "Cain") s
429# 7 <$> const(PV "Abel") s
430# 8 <0> pushmark s
431# 9 <$> gv(*harry) s
432# a <1> rv2av[t1] lKRM*/1
433# b <2> aassign[t2] vKS
434# c <;> nextstate(main 602 (eval 32):3) v
435# d <0> pushmark s
436# e <$> const(PV "gone") s
437# f <$> const(PV "chased") s
438# g <$> const(PV "yz") s
439# h <$> const(PV "Punished") s
440# i <$> const(PV "Axed") s
441# j <0> pushmark s
442# k <$> gv(*george) s
443# l <1> rv2av[t3] lKRM*/1
444# m <2> aassign[t4] vKS
445# n <;> nextstate(main 602 (eval 32):4) v
446# o <0> pushmark s
447# p <0> pushmark s
448# q <$> gv(*harry) s
449# r <1> rv2av[t5] lK/1
450# s <@> sort lK
451# t <@> print vK
452# u <;> nextstate(main 602 (eval 32):4) v
453# v <0> pushmark s
454# w <0> pushmark s
455# x <$> const(PV "backwards") s/BARE
456# y <$> gv(*harry) s
457# z <1> rv2av[t6] lK/1
458# 10 <@> sort lKS
459# 11 <@> print vK
460# 12 <;> nextstate(main 602 (eval 32):5) v
461# 13 <0> pushmark s
462# 14 <0> pushmark s
463# 15 <$> gv(*george) s
464# 16 <1> rv2av[t7] lK/1
465# 17 <$> const(PV "to") s
466# 18 <$> gv(*harry) s
467# 19 <1> rv2av[t8] lK/1
468# 1a <@> sort lK
469# 1b <@> print sK
470# 1c <1> leavesub[1 ref] K/REFC,1
471EONT_EONT
472
473
474=for gentest
475
476# chunk: # inefficiently sort by descending numeric compare using
477# the first integer after the first = sign, or the
478# whole record case-insensitively otherwise
479@new = @old[ sort {
480 $nums[$b] <=> $nums[$a]
481 || $caps[$a] cmp $caps[$b]
482 } 0..$#old ];
483
484=cut
485=for gentest
486
487# chunk: # same thing, but without any temps
488@new = map { $_->[0] }
489sort { $b->[1] <=> $a->[1]
490 || $a->[2] cmp $b->[2]
491 } map { [$_, /=(\d+)/, uc($_)] } @old;
492
493=cut
494
7ce9b5fb 495checkOptree(name => q{Compound sort/map Expression },
cc02ea56 496 bcopts => q{-exec},
497 code => q{ @new = map { $_->[0] }
498 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
499 map { [$_, /=(\d+)/, uc($_)] } @old; },
500 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
501# 1 <;> nextstate(main 609 (eval 34):3) v
502# 2 <0> pushmark s
503# 3 <0> pushmark s
504# 4 <0> pushmark s
505# 5 <0> pushmark s
506# 6 <#> gv[*old] s
507# 7 <1> rv2av[t19] lKM/1
508# 8 <@> mapstart lK*
509# 9 <|> mapwhile(other->a)[t20] lK
510# a <0> enter l
511# b <;> nextstate(main 608 (eval 34):2) v
512# c <0> pushmark s
513# d <#> gvsv[*_] s
514# e </> match(/"=(\\d+)"/) l/RTIME
515# f <#> gvsv[*_] s
516# g <1> uc[t17] sK/1
517# h <@> anonlist sKRM/1
518# i <1> srefgen sK/1
519# j <@> leave lKP
520# goto 9
521# k <@> sort lKMS*
522# l <@> mapstart lK*
523# m <|> mapwhile(other->n)[t26] lK
524# n <#> gv[*_] s
525# o <1> rv2sv sKM/DREFAV,1
526# p <1> rv2av[t4] sKR/1
527# q <$> const[IV 0] s
528# r <2> aelem sK/2
529# - <@> scope lK
530# goto m
531# s <0> pushmark s
532# t <#> gv[*new] s
533# u <1> rv2av[t2] lKRM*/1
534# v <2> aassign[t27] KS/COMMON
535# w <1> leavesub[1 ref] K/REFC,1
536EOT_EOT
537# 1 <;> nextstate(main 609 (eval 34):3) v
538# 2 <0> pushmark s
539# 3 <0> pushmark s
540# 4 <0> pushmark s
541# 5 <0> pushmark s
542# 6 <$> gv(*old) s
543# 7 <1> rv2av[t10] lKM/1
544# 8 <@> mapstart lK*
545# 9 <|> mapwhile(other->a)[t11] lK
546# a <0> enter l
547# b <;> nextstate(main 608 (eval 34):2) v
548# c <0> pushmark s
549# d <$> gvsv(*_) s
550# e </> match(/"=(\\d+)"/) l/RTIME
551# f <$> gvsv(*_) s
552# g <1> uc[t9] sK/1
553# h <@> anonlist sKRM/1
554# i <1> srefgen sK/1
555# j <@> leave lKP
556# goto 9
557# k <@> sort lKMS*
558# l <@> mapstart lK*
559# m <|> mapwhile(other->n)[t12] lK
560# n <$> gv(*_) s
561# o <1> rv2sv sKM/DREFAV,1
562# p <1> rv2av[t2] sKR/1
563# q <$> const(IV 0) s
564# r <2> aelem sK/2
565# - <@> scope lK
566# goto m
567# s <0> pushmark s
568# t <$> gv(*new) s
569# u <1> rv2av[t1] lKRM*/1
570# v <2> aassign[t13] KS/COMMON
571# w <1> leavesub[1 ref] K/REFC,1
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');
591# 1 <;> nextstate(main 614 (eval 36):2) v
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
601# b <2> aassign[t5] KS
602# c <1> leavesub[1 ref] K/REFC,1
603EOT_EOT
604# 1 <;> nextstate(main 614 (eval 36):2) v
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
614# b <2> aassign[t3] KS
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
641# b <2> aassign[t5] KS
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
654# b <2> aassign[t3] KS
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');
671# 1 <;> nextstate(main 656 (eval 40):1) v
672# 2 <0> pushmark s
673# 3 <0> pushmark s
674# 4 <#> gv[*old] s
675# 5 <1> rv2av[t9] lK/1
676# 6 <@> sort lKS*
677# 7 <0> pushmark s
678# 8 <#> gv[*new] s
679# 9 <1> rv2av[t2] lKRM*/1
680# a <2> aassign[t14] KS
681# b <1> leavesub[1 ref] K/REFC,1
682EOT_EOT
683# 1 <;> nextstate(main 578 (eval 15):1) v
684# 2 <0> pushmark s
685# 3 <0> pushmark s
686# 4 <$> gv(*old) s
687# 5 <1> rv2av[t5] lK/1
688# 6 <@> sort lKS*
689# 7 <0> pushmark s
690# 8 <$> gv(*new) s
691# 9 <1> rv2av[t1] lKRM*/1
692# a <2> aassign[t6] KS
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');
709# 1 <;> nextstate(main 662 (eval 42):1) v
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
718# a <2> aassign[t14] KS
719# b <1> leavesub[1 ref] K/REFC,1
720EOT_EOT
721# 1 <;> nextstate(main 578 (eval 15):1) v
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
730# a <2> aassign[t6] KS
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
755# a <2> aassign[t8] KS
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
767# a <2> aassign[t4] KS
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
800# g <2> aassign[t5] KS/COMMON
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');
906# 1 <;> nextstate(main 689 (eval 52):1) v
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
915# 1 <;> nextstate(main 546 (eval 15):1) v
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');
936# 1 <;> nextstate(main 695 (eval 54):1) v
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
953# 1 <;> nextstate(main 547 (eval 15):1) v
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