| blob | 50fbac5dcd07ce944e0a33d921046f8ef441f196 |
1 #!perl
2 # Copyright (C) 2001-2007, The Perl Foundation.
3 # $Id$
5 use strict;
6 use warnings;
7 use lib qw( . lib ../lib ../../lib );
9 use Test::More;
10 use Parrot::Test tests => 96;
12 =head1 NAME
14 t/op/calling.t - Parrot Calling Conventions
16 =head1 SYNOPSIS
18 % prove t/op/calling.t
20 =head1 DESCRIPTION
22 Tests Parrot calling conventions.
24 =cut
26 pasm_output_is( <<'CODE', <<'OUTPUT', "set_args - parsing" );
27 noop
28 set_args "0, 0", P0, I0
29 print "Ok 1\n"
30 set_args ""
31 print "Ok 2\n"
32 end
33 CODE
34 Ok 1
35 Ok 2
36 OUTPUT
38 pasm_output_is( <<'CODE', <<'OUTPUT', "var_args - parsing" );
39 .pcc_sub main:
40 print "Ok 1\n"
41 set_args "0, 0", P0, I0
42 get_results "0", I0
43 find_name P1, "foo"
44 print "Ok 2\n"
45 invokecc P1
46 print "Ok 5\n"
47 end
48 .pcc_sub foo:
49 get_params "0, 0", P0, I0
50 print "Ok 3\n"
51 set_returns "0", 42
52 print "Ok 4\n"
53 returncc
54 CODE
55 Ok 1
56 Ok 2
57 Ok 3
58 Ok 4
59 Ok 5
60 OUTPUT
62 pasm_output_is( <<'CODE', <<'OUTPUT', "call - i, ic" );
63 .pcc_sub main:
64 set I16, 77
65 set_args "0, 0", 42, I16
66 find_name P1, "foo"
67 invokecc P1
68 print "back\n"
69 end
70 .pcc_sub foo:
71 get_params "0, 0", I16, I17
72 print I16
73 print "\n"
74 print I17
75 print "\n"
76 returncc
77 CODE
78 42
79 77
80 back
81 OUTPUT
83 pasm_output_is( <<'CODE', <<'OUTPUT', "call - i, ic, return i, ic" );
84 .pcc_sub main:
85 set I16, 77
86 set_args "0, 0", 42, I16
87 get_results "0, 0", I16, I17
88 find_name P1, "foo"
89 invokecc P1
90 print I16
91 print "\n"
92 print I17
93 print "\nback\n"
94 end
95 .pcc_sub foo:
96 get_params "0, 0", I16, I17
97 print I16
98 print "\n"
99 print I17
100 print "\n"
101 set I16, 88
102 set_returns "0, 0", 99, I16
103 returncc
104 CODE
105 42
106 77
107 99
108 88
109 back
110 OUTPUT
112 pasm_output_is( <<'CODE', <<'OUTPUT', "call - i, ic, return i, ic - adjust sig" );
113 .pcc_sub main:
114 set I16, 77
115 set_args "0, 0", 42, I16
116 get_results "0, 0", I16, I17
117 find_name P1, "foo"
118 invokecc P1
119 print I16
120 print "\n"
121 print I17
122 print "\nback\n"
123 end
124 .pcc_sub foo:
125 get_params "0, 0", I16, I17
126 print I16
127 print "\n"
128 print I17
129 print "\n"
130 set I16, 88
131 set_returns "0, 0", 99, I16
132 returncc
133 CODE
134 42
135 77
136 99
137 88
138 back
139 OUTPUT
141 pasm_output_is( <<'CODE', <<'OUTPUT', "all together now" );
142 .pcc_sub main:
143 set I16, 77
144 set N16, 2.3
145 set S16, "ok 1\n"
146 new P16, 'Integer'
147 set P16, 101
148 set_args "0, 0, 0, 0, 0, 0, 0", 42, I16, 4.5, N16, S16, "ok 2\n", P16
149 get_results "0, 0, 0, 0", I16, N16, S16, P16
150 find_name P1, "foo"
151 invokecc P1
152 print I16
153 print "\n"
154 print N16
155 print "\n"
156 print S16
157 print P16
158 end
159 .pcc_sub foo:
160 get_params "0, 0, 0, 0, 0, 0, 0", I16, I17, N16, N17, S16, S17, P16
161 print I16
162 print "\n"
163 print I17
164 print "\n"
165 print N16
166 print "\n"
167 print N17
168 print "\n"
169 print S16
170 print S17
171 print P16
172 print "\n"
173 set I16, 88
174 set N16, 5.5
175 set S16, "ok 3\n"
176 new P16, 'String'
177 set P16, "ok 4\n"
178 set_returns "0, 0, 0, 0", I16, N16, S16, P16
179 returncc
180 CODE
181 42
182 77
183 4.500000
184 2.300000
185 ok 1
186 ok 2
187 101
188 88
189 5.500000
190 ok 3
191 ok 4
192 OUTPUT
194 pasm_output_is( <<'CODE', <<'OUTPUT', "flatten arg" );
195 .pcc_sub main:
196 new P16, 'String'
197 set P16, "ok 1\n"
198 new P17, 'ResizablePMCArray'
199 push P17, "ok 2\n"
200 push P17, "ok 3\n"
201 push P17, "ok 4\n"
202 new P18, 'String'
203 set P18, "ok 5\n"
204 set_args "0, 0x20, 0", P16, P17, P18
205 find_name P1, "foo"
206 invokecc P1
207 print "back\n"
208 end
209 .pcc_sub foo:
210 get_params "0, 0, 0, 0, 0", P1, P2, P3, P4, P5
211 print P1
212 print P2
213 print P3
214 print P4
215 print P5
216 returncc
217 CODE
218 ok 1
219 ok 2
220 ok 3
221 ok 4
222 ok 5
223 back
224 OUTPUT
226 pasm_output_is( <<'CODE', <<'OUTPUT', "slurpy param" );
227 .pcc_sub main:
228 new P16, 'String'
229 set P16, "ok 1\n"
230 new P17, 'String'
231 set P17, "ok 2\n"
232 new P18, 'String'
233 set P18, "ok 3\n"
234 set_args "0, 0, 0", P16, P17, P18
235 find_name P1, "foo"
236 invokecc P1
237 print "back\n"
238 end
239 .pcc_sub foo:
240 get_params "0, 0x20", P1, P2
241 print P1
242 set I0, P2
243 print I0
244 print "\n"
245 set S0, P2[0]
246 print S0
247 set S0, P2[1]
248 print S0
249 returncc
250 CODE
251 ok 1
252 2
253 ok 2
254 ok 3
255 back
256 OUTPUT
258 pir_output_is( <<'CODE', <<'OUTPUT', "use it in PIR" );
259 .sub main :main
260 $P0 = new 'String'
261 $P0 = "hello\n"
262 find_name $P1, "foo"
263 # set_args and invoke must be adjacent
264 set_args "0", $P0
265 invokecc $P1
266 .end
267 .sub foo
268 get_params "0", $P0
269 print $P0
270 .end
271 CODE
272 hello
273 OUTPUT
275 pasm_output_is( <<'CODE', <<'OUTPUT', "flatten + slurpy param" );
276 .pcc_sub main:
277 new P16, 'String'
278 set P16, "ok 1\n"
279 new P19, 'ResizablePMCArray'
280 new P17, 'String'
281 set P17, "ok 2\n"
282 push P19, P17
283 new P18, 'String'
284 set P18, "ok 3\n"
285 push P19, P18
286 new P20, 'ResizablePMCArray'
287 new P17, 'String'
288 set P17, "ok 4\n"
289 push P20, P17
290 new P18, 'String'
291 set P18, "ok 5\n"
292 push P20, P18
293 new P21, 'String'
294 set P21, "ok 6\n"
295 set_args "0, 0x20, 0x20, 0", P16, P19, P20, P21
296 find_name P1, "foo"
297 invokecc P1
298 print "back\n"
299 end
300 .pcc_sub foo:
301 get_params "0, 0x20", P1, P2
302 print P1
303 set I0, P2
304 print I0
305 print "\n"
306 set S0, P2[0]
307 print S0
308 set S0, P2[1]
309 print S0
310 set S0, P2[2]
311 print S0
312 set S0, P2[3]
313 print S0
314 set S0, P2[4]
315 print S0
316 set P0, P2[5]
317 if_null P0, ok
318 print "not ok 7\n"
319 ok:
320 returncc
321 CODE
322 ok 1
323 5
324 ok 2
325 ok 3
326 ok 4
327 ok 5
328 ok 6
329 back
330 OUTPUT
332 pir_output_is( <<'CODE', <<'OUTPUT', "use it in PIR" );
333 .sub main :main
334 $P0 = new 'String'
335 $P0 = "hello\n"
336 find_name $P1, "foo"
337 # set_args and invoke must be adjacent
338 set_args "0", $P0
339 invokecc $P1
340 .end
341 .sub foo
342 get_params "0", $P0
343 print $P0
344 .end
345 CODE
346 hello
347 OUTPUT
349 pir_output_is( <<'CODE', <<'OUTPUT', "type conversion - autobox" );
350 .sub main :main
351 $P0 = new 'String'
352 $P0 = "hello"
353 find_name $P1, "foo"
354 # set_args and invoke must be adjacent
355 set_args "0,0,0", $P0, 42, "bar"
356 invokecc $P1
357 .end
358 .sub foo
359 get_params "0x20", $P0
360 $S0 = $P0[0]
361 print $S0
362 print ' '
363 $S0 = $P0[1]
364 print $S0
365 print ' '
366 $S0 = $P0[2]
367 print $S0
368 print "\n"
369 .end
370 CODE
371 hello 42 bar
372 OUTPUT
374 pir_output_is( <<'CODE', <<'OUTPUT', "more autobox" );
375 .sub main :main
376 foo( 101, 0.77, 'seven and seven is' )
377 .end
379 .sub foo
380 .param pmc some_int
381 .param pmc some_float
382 .param pmc some_string
384 $S0 = typeof some_int
385 print $S0
386 print "\n"
388 $S0 = typeof some_float
389 print $S0
390 print "\n"
392 $S0 = typeof some_string
393 print $S0
394 print "\n"
396 .return()
397 .end
398 CODE
399 Integer
400 Float
401 String
402 OUTPUT
404 pir_output_is( <<'CODE', <<'OUTPUT', "type conversion - fetch" );
405 .sub main :main
406 $P0 = new 'String'
407 $P0 = "hello"
408 $P1 = new 'Integer'
409 $P1 = 42
410 $P2 = new 'String'
411 $P2 = "again"
412 $P3 = new 'Float'
413 $P3 = 47.11
414 find_name $P10, "foo"
415 # set_args and invoke must be adjacent
416 set_args "0,0,0,0", $P0, $P1, $P2, $P3
417 invokecc $P10
418 .end
419 .sub foo
420 get_params "0,0,0,0", $P0, $I0, $S0, $N0
421 print $P0
422 print ' '
423 print $I0
424 print ' '
425 print $S0
426 print ' '
427 print $N0
428 print "\n"
429 returncc
430 .end
431 CODE
432 hello 42 again 47.110000
433 OUTPUT
435 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, too few" );
436 .sub main :main
437 .include "errors.pasm"
438 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
439 $P0 = new 'String'
440 $P0 = "hello\n"
441 find_name $P1, "foo"
442 set_args "0", $P0
443 invokecc $P1
444 .end
445 .sub foo
446 get_params "0,0", $P0, $P1
447 print $P0
448 .end
449 CODE
450 /too few arguments passed/
451 OUTPUT
453 pir_output_like(
454 <<'CODE', <<'OUTPUT', "argc mismatch, too many - no getparams", todo => 'no get_params at all' );
455 .sub main :main
456 .include "errors.pasm"
457 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
458 foo(5)
459 .end
460 .sub foo
461 print "nada"
462 .end
463 CODE
464 /too many arguments passed/
465 OUTPUT
467 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, too many - force get_params" );
468 .macro no_params
469 get_params '()'
470 .endm
471 .sub main :main
472 .include "errors.pasm"
473 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
474 foo(5)
475 .end
476 .sub foo
477 .no_params
478 print "nada"
479 .end
480 CODE
481 /too many arguments passed/
482 OUTPUT
484 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, too many" );
485 .sub main :main
486 .include "errors.pasm"
487 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
488 $P0 = new 'String'
489 $P0 = "hello\n"
490 find_name $P1, "foo"
491 set_args "0,0", $P0,77
492 invokecc $P1
493 .end
494 .sub foo
495 get_params "0", $P0
496 print $P0
497 .end
498 CODE
499 /too many arguments passed/
500 OUTPUT
502 pir_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, too many - catch exception" );
503 .sub main :main
504 .include "errors.pasm"
505 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
506 $P0 = new 'String'
507 $P0 = "hello\n"
508 find_name $P1, "foo"
509 set_args "0,0", $P0,77
510 invokecc $P1
511 .end
512 .sub foo
513 push_eh arg_handler
514 get_params "0", $P0
515 print $P0
516 print "never\n"
517 arg_handler:
518 get_results "0,0", $P1, $S0
519 print "catched: "
520 print $S0
521 .end
522 CODE
523 /^catched: too many arguments passed/
524 OUTPUT
526 pir_output_is( <<'CODE', <<'OUTPUT', "argc mismatch, optional" );
527 .sub main :main
528 .include "errors.pasm"
529 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
530 $P0 = new 'String'
531 $P0 = "hello\n"
532 find_name $P1, "foo"
533 set_args "0", $P0
534 invokecc $P1
535 .end
536 .sub foo
537 get_params "0,0x80,0x100", $P0, $P1, $I0
538 print $P0
539 if_null $P1, ok
540 print "not "
541 ok:
542 print "ok\n"
543 .end
544 CODE
545 hello
546 ok
547 OUTPUT
549 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, optional" );
550 .sub main :main
551 .include "errors.pasm"
552 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
553 .local pmc ar
554 ar = new 'ResizableIntegerArray'
555 push ar, 1
556 push ar, 2
557 push ar, 3
558 push ar, 4
559 foo(ar :flat)
560 print "never\n"
561 .end
562 .sub foo
563 .param int i
564 .param int j :optional
565 .param int got_j :opt_flag
566 .param int k :optional
567 .param int got_k :opt_flag
568 .end
569 CODE
570 /too many arguments passed/
571 OUTPUT
573 pasm_output_is( <<'CODE', <<'OUTPUT', "get_param later" );
574 .pcc_sub main:
575 set I16, 77
576 set_args "0, 0", 42, I16
577 get_results "0, 0", I16, I17
578 find_name P1, "foo"
579 invokecc P1
580 print I16
581 print "\n"
582 print I17
583 print "\nback\n"
584 end
585 .pcc_sub foo:
586 noop
587 get_params "0, 0", I16, I17
588 print I16
589 print "\n"
590 print I17
591 print "\n"
592 set I16, 88
593 set_returns "4, 0", 99, I16
594 returncc
595 CODE
596 42
597 77
598 99
599 88
600 back
601 OUTPUT
603 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall 1" );
604 .sub main :main
605 .const .Sub f = "foo"
606 print "main\n"
607 get_results "0", $S0
608 invokecc f
609 print $S0
610 .end
611 .sub foo
612 .const .Sub b = "bar"
613 print "foo\n"
614 tailcall b
615 .end
616 .sub bar
617 print "bar\n"
618 set_returns "0", "bar_ret\n"
619 returncc
620 .end
621 CODE
622 main
623 foo
624 bar
625 bar_ret
626 OUTPUT
628 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall 2 - pass arg" );
629 .sub main :main
630 .const .Sub f = "foo"
631 print "main\n"
632 get_results "0", $S0
633 invokecc f
634 print $S0
635 .end
636 .sub foo
637 .const .Sub b = "bar"
638 print "foo\n"
639 set_args "0", "from_foo\n"
640 tailcall b
641 .end
642 .sub bar
643 get_params "0", $S0
644 print "bar\n"
645 print $S0
646 set_returns "0", "bar_ret\n"
647 returncc
648 .end
649 CODE
650 main
651 foo
652 bar
653 from_foo
654 bar_ret
655 OUTPUT
657 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall 3 - pass arg" );
658 .sub main :main
659 .const .Sub f = "foo"
660 print "main\n"
661 get_results "0", $S0
662 invokecc f
663 print $S0
664 .end
665 .sub foo
666 .const .Sub b = "bar"
667 print "foo\n"
668 set_args "0", "from_foo\n"
669 tailcall b
670 .end
671 .sub bar
672 get_params "0", $S0
673 print "bar\n"
674 print $S0
675 set_returns "0", "bar_ret\n"
676 returncc
677 .end
678 CODE
679 main
680 foo
681 bar
682 from_foo
683 bar_ret
684 OUTPUT
686 pir_output_is( <<'CODE', <<'OUTPUT', "empty args" );
687 .sub main :main
688 $P0 = new 'String'
689 $P0 = "hello\n"
690 find_name $P1, "foo"
691 set_args ""
692 invokecc $P1
693 .end
694 .sub foo
695 get_params "0x80, 0x100", $P1, $I0
696 if_null $P1, ok
697 print "not "
698 ok:
699 print "ok\n"
700 .end
701 CODE
702 ok
703 OUTPUT
705 pir_output_is( <<'CODE', <<'OUTPUT', "optional args" );
706 .sub main :main
707 $P0 = new 'String'
708 $P0 = "hello\n"
709 find_name $P1, "foo"
710 set_args "0x0", $P0
711 invokecc $P1
712 .end
713 .sub foo
714 get_params "0x80, 0x100", $P1, $I0
715 unless_null $P1, ok
716 print "not "
717 ok:
718 print "ok\n"
719 .end
720 CODE
721 ok
722 OUTPUT
724 pir_output_is( <<'CODE', <<'OUTPUT', "pir uses no ops" );
725 .sub main :main
726 $I0 = 77
727 foo(42, $I0)
728 print "back\n"
729 .end
731 .sub foo
732 get_params "0, 0", I16, I17
733 print I16
734 print "\n"
735 print I17
736 print "\n"
737 set_returns ""
738 returncc
739 .end
740 CODE
741 42
742 77
743 back
744 OUTPUT
746 pir_output_is( <<'CODE', <<'OUTPUT', "pir call evaled code" );
747 .sub main :main
748 .local string s
749 s = ".sub foo\n"
750 s .= ".param int i\n"
751 s .= ".param int j\n"
752 s .= "print i\n"
753 s .= "print ' '\n"
754 s .= "print j\n"
755 s .= "print \"\\n\"\n"
756 s .= ".return(99)\n"
757 s .= ".end\n"
758 .local pmc comp
759 comp = compreg "PIR"
760 $P0 = comp(s)
761 $I0 = 77
762 $I0 = foo(42, $I0)
763 print $I0
764 print "\n"
765 .end
767 CODE
768 42 77
769 99
770 OUTPUT
772 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall 4 - pir calls" );
773 .sub main :main
774 .const .Sub f = "foo"
775 print "main\n"
776 $S0 = f()
777 print $S0
778 .end
779 .sub foo
780 .const .Sub b = "bar"
781 print "foo\n"
782 .return b("from_foo\n")
783 .end
784 .sub bar
785 .param string s
786 print "bar\n"
787 print s
788 .return ("bar_ret\n")
789 .end
790 CODE
791 main
792 foo
793 bar
794 from_foo
795 bar_ret
796 OUTPUT
798 pir_output_is( <<'CODE', <<'OUTPUT', "type conversion - native" );
799 .sub main :main
800 foo_int(42, "42", 42.20)
801 foo_float(42, "42", 42.20)
802 foo_string(42, "42", 42.20)
803 .end
804 .sub foo_int
805 get_params "0,0,0", $I0, $I1, $I2
806 print $I0
807 print ' '
808 print $I1
809 print ' '
810 print $I2
811 print "\n"
812 .end
813 .sub foo_float
814 get_params "0,0,0", $N0, $N1, $N2
815 print $N0
816 print ' '
817 print $N1
818 print ' '
819 print $N2
820 print "\n"
821 .end
822 .sub foo_string
823 get_params "0,0,0", $S0, $S1, $S2
824 print $S0
825 print ' '
826 print $S1
827 print ' '
828 print $S2
829 print "\n"
830 .end
831 CODE
832 42 42 42
833 42.000000 42.000000 42.200000
834 42 42 42.2
835 OUTPUT
837 pir_output_is( <<'CODE', <<'OUTPUT', "type conversion - PIR const" );
838 .const int MYCONST = -2
839 .sub main :main
840 $P0 = new 'String'
841 "foo"(MYCONST)
842 .end
843 .sub "foo"
844 .param string str1 :optional
845 .param int has_s :opt_flag
846 print str1
847 print "\n"
848 .end
849 CODE
850 -2
851 OUTPUT
853 pir_output_is( <<'CODE', <<'OUTPUT', "optional args, :opt_flag" );
854 .sub main :main
855 $P0 = new 'String'
856 $P0 = "hello\n"
857 foo($P0)
858 foo()
859 .end
860 .sub foo
861 .param pmc p1 :optional
862 .param int i1 :opt_flag
864 if_null p1, skip
865 print p1
866 skip:
867 print i1
868 print "\n"
869 .end
870 CODE
871 hello
872 1
873 0
874 OUTPUT
876 pir_output_is( <<'CODE', <<'OUTPUT', "optional multiple :opt_flag" );
877 .sub main :main
878 $P0 = new 'String'
879 $P0 = "ok 1\n"
880 foo($P0, "ok 2\n", "ok 3\n")
881 .end
882 .sub foo
883 .param pmc p1 :optional
884 .param int i1 :opt_flag
885 .param pmc p2 :optional
886 .param int i2 :opt_flag
887 .param pmc p3 :optional
888 .param int i3 :opt_flag
889 .param pmc p4 :optional
890 .param int i4 :opt_flag
892 print p1
893 print p2
894 print p3
895 if_null p4, ok
896 print "not "
897 ok:
898 print "ok 4\n"
899 print i1
900 print ' '
901 print i2
902 print ' '
903 print i3
904 print ' '
905 print i4
906 print "\n"
907 .end
910 CODE
911 ok 1
912 ok 2
913 ok 3
914 ok 4
915 1 1 1 0
916 OUTPUT
918 pir_output_is( <<'CODE', <<'OUTPUT', "optional returns, void ret" );
919 .sub main :main
920 .local pmc f
921 $I0 = 99
922 f = global "foo"
923 .begin_call
924 .call f
925 .result $P0 :optional
926 .result $I0 :opt_flag
927 .end_call
928 unless $I0, ex
929 print "not "
930 ex:
931 print "ok 1\n"
932 .end
933 .sub foo
934 .end
935 CODE
936 ok 1
937 OUTPUT
939 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall 5 - arg/param conflict" );
940 .sub main :main
941 .local pmc a, b
942 a = new 'Integer'
943 a = 1
944 b = new 'Integer'
945 b = 2
946 .local pmc c, d
947 (c, d) = foo(a, b)
948 eq_addr a, c, ok1
949 print "not "
950 ok1:
951 print "ok 1\n"
952 eq_addr b, d, ok2
953 print "not "
954 ok2:
955 print "ok 2\n"
956 .end
958 .sub foo
959 .param pmc a
960 .param pmc b
961 $P0 = new 'Integer'
962 $P0 = 3
963 .return bar($P0, a, b)
964 .end
966 .sub bar
967 .param pmc x
968 .param pmc a
969 .param pmc b
970 .return (a, b)
971 .end
972 CODE
973 ok 1
974 ok 2
975 OUTPUT
977 pir_output_is( <<'CODE', <<'OUTPUT', "OO argument passing" );
978 .sub main :main
979 .local pmc cl, o, f
980 cl = newclass "Foo"
981 o = new "Foo"
982 o."bar"("ok 1\n")
983 f = get_global ["Foo"], "bar"
984 f(o, "ok 2\n")
985 o."baz"("ok 3\n")
986 f = get_global ["Foo"], "baz"
987 f(o, "ok 4\n")
988 .end
989 .namespace ["Foo"]
990 .sub bar :method
991 .param string s
992 print self
993 print " "
994 print s
995 .end
996 .sub baz :method
997 .param string s
998 print self
999 print " "
1000 print s
1001 .end
1002 .sub get_string :vtable :method
1003 $S0 = typeof self
1004 .return ($S0)
1005 .end
1006 CODE
1007 Foo ok 1
1008 Foo ok 2
1009 Foo ok 3
1010 Foo ok 4
1011 OUTPUT
1013 pir_output_is( <<'CODE', <<'OUTPUT', "OO argument passing - 2" );
1014 .sub main :main
1015 .local pmc cl, o, f
1016 cl = newclass "Foo"
1017 o = new "Foo"
1018 $S0 = o
1019 print $S0
1020 $S1 = o[2]
1021 print $S1
1022 print $S0
1023 .end
1024 .namespace ["Foo"]
1025 .sub get_string :vtable :method
1026 $S0 = typeof self
1027 print $S0
1028 print " "
1029 .return ("ok 1\n")
1030 .end
1031 .sub get_string_keyed_int :vtable :method
1032 .param int key
1033 $S0 = "ok "
1034 $S1 = key
1035 $S0 .= $S1
1036 $S0 .= "\n"
1037 .return ($S0)
1038 .end
1039 CODE
1040 Foo ok 1
1041 ok 2
1042 ok 1
1043 OUTPUT
1045 pir_output_is( <<'CODE', <<'OUTPUT', "OO argument passing - 3" );
1046 .sub main :main
1047 .local pmc cl, o, f
1048 cl = newclass "Foo"
1049 o = new "Foo"
1050 $S0 = foo(o)
1051 print $S0
1052 .end
1053 .sub foo
1054 .param pmc arg
1055 .return (arg) # force conversion to string
1056 .end
1057 .namespace ["Foo"]
1058 .sub get_string :vtable :method
1059 $S0 = typeof self
1060 print $S0
1061 print " "
1062 .return ("ok 1\n")
1063 .end
1065 CODE
1066 Foo ok 1
1067 OUTPUT
1069 # see also tcl in leo-ctx5 by Coke; Date 28.08.2005
1070 pir_output_is( <<'CODE', <<'OUTPUT', "bug - :slurpy promotes to :flatten" );
1071 .sub main :main
1072 $P0 = new 'String'
1073 $P0 = "ok 1\n"
1074 $P1 = new 'String'
1075 $P1 = "ok 2\n"
1076 $P0 = foo($P0, $P1)
1077 print $P0
1078 .end
1079 .sub foo
1080 .param pmc p :slurpy
1081 .return bar(p)
1082 .end
1083 .sub bar
1084 .param pmc p
1085 .local pmc q
1086 q = p[0]
1087 print q
1088 q = p[1]
1089 .return (q)
1090 .end
1091 CODE
1092 ok 1
1093 ok 2
1094 OUTPUT
1096 pir_output_is( <<'CODE', <<'OUTPUT', "call :slurpy with :flat" );
1097 .sub _fn1
1098 .param pmc rest_arg :slurpy
1099 print "[in _fn1]\n"
1100 print rest_arg
1101 print "\n"
1102 .end
1103 .sub main :main
1104 $P34 = new 'Array'
1105 $P34 = 0
1106 ## normal flattening direct call, non-slurpy returns
1107 $P35 = _fn1($P34 :flat)
1108 .end
1109 CODE
1110 [in _fn1]
1111 0
1112 OUTPUT
1114 pir_output_is( <<'CODE', <<'OUTPUT', "call with :flat in the middle" );
1115 .sub _fn1
1116 .param int arg1
1117 .param int arg2
1118 .param int arg3
1119 .param int arg4
1120 print arg1
1121 print ' '
1122 print arg2
1123 print ' '
1124 print arg3
1125 print ' '
1126 print arg4
1127 print "\n"
1128 .end
1129 .sub main :main
1130 $P30 = new 'Integer'
1131 $P30 = 2
1132 $P31 = new 'Integer'
1133 $P31 = 3
1134 $P34 = new 'Array'
1135 $P34 = 2
1136 $P34[0] = $P30
1137 $P34[1] = $P31
1138 $I4 = 4
1139 $P35 = _fn1(1, $P34 :flat, $I4)
1140 .end
1141 CODE
1142 1 2 3 4
1143 OUTPUT
1145 pir_output_is( <<'CODE', <<'OUTPUT', "right number of args via :flat" );
1146 .sub _fn1
1147 .param int arg1
1148 .param int arg2
1149 .param int arg3
1150 .param int arg4
1151 print arg1
1152 print ' '
1153 print arg2
1154 print ' '
1155 print arg3
1156 print ' '
1157 print arg4
1158 print "\n"
1159 .end
1160 .sub main :main
1161 .include "errors.pasm"
1162 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
1163 $P30 = new 'Integer'
1164 $P30 = 2
1165 $P31 = new 'Integer'
1166 $P31 = 3
1167 $P34 = new 'Array'
1168 $P34 = 3
1169 $P34[0] = $P30
1170 $P34[1] = $P31
1171 $P34[2] = $P30
1172 $P35 = _fn1(1, $P34 :flat)
1173 .end
1174 CODE
1175 1 2 3 2
1176 OUTPUT
1178 pir_error_output_like( <<'CODE', <<'OUTPUT', "too many args via :flat" );
1179 .sub _fn1
1180 .param int arg1
1181 .param int arg2
1182 .param int arg3
1183 .param int arg4
1184 print arg1
1185 print ' '
1186 print arg2
1187 print ' '
1188 print arg3
1189 print ' '
1190 print arg4
1191 print "\n"
1192 .end
1193 .sub main :main
1194 .include "errors.pasm"
1195 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
1196 $P30 = new 'Integer'
1197 $P30 = 2
1198 $P31 = new 'Integer'
1199 $P31 = 3
1200 $P34 = new 'Array'
1201 $P34 = 4
1202 $P34[0] = $P30
1203 $P34[1] = $P31
1204 $P34[2] = $P30
1205 $P34[3] = $P31
1206 $P35 = _fn1(1, $P34 :flat)
1207 .end
1208 CODE
1209 /too many arguments passed \(5\) - 4 params expected/
1210 OUTPUT
1212 pir_error_output_like( <<'CODE', <<'OUTPUT', "too few args via :flat" );
1213 .sub _fn1
1214 .param int arg1
1215 .param int arg2
1216 .param int arg3
1217 .param int arg4
1218 print arg1
1219 print ' '
1220 print arg2
1221 print ' '
1222 print arg3
1223 print ' '
1224 print arg4
1225 print "\n"
1226 .end
1227 .sub main :main
1228 .include "errors.pasm"
1229 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
1230 $P30 = new 'Integer'
1231 $P30 = 2
1232 $P31 = new 'Integer'
1233 $P31 = 3
1234 $P34 = new 'Array'
1235 $P34 = 2
1236 $P34[0] = $P30
1237 $P34[1] = $P31
1238 $P35 = _fn1(1, $P34 :flat)
1239 .end
1240 CODE
1241 /too few arguments passed \(3\) - 4 params expected/
1242 OUTPUT
1244 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall to NCI" );
1245 .sub main :main
1246 .local pmc s
1247 s = new 'String'
1248 s = "OK 1\n"
1249 $S0 = s."lower"()
1250 print $S0
1251 s = "OK 2\n"
1252 $S1 = foo(s)
1253 print $S1
1254 .end
1255 .sub foo
1256 .param pmc s
1257 $S0 = s."lower"()
1258 .return ($S0)
1259 .end
1260 CODE
1261 ok 1
1262 ok 2
1263 OUTPUT
1265 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall to NCI - 2" );
1266 .sub main :main
1267 $P0 = eval("print \"Foo!\\n\"")
1268 $P0()
1269 end
1270 .end
1272 .sub eval
1273 .param string code
1274 code = ".sub main :main :anon\n" . code
1275 code = code . "\n.end\n"
1276 $P0 = compreg "PIR"
1277 .return $P0(code)
1278 .end
1279 CODE
1280 Foo!
1281 OUTPUT
1283 # bug - repeated calls to eval'd sub crashes (pmichaud, 2005.10.27)
1284 pir_output_is( <<'CODE', <<'OUTPUT', "repeated calls to eval'd sub" );
1285 .sub main :main
1286 .local string s
1287 .local pmc outer
1288 s = ".namespace [ \"XYZ\" ]\n"
1289 s .= ".sub outer\n"
1290 s .= " .param int n\n"
1291 s .= " $I0 = n % 1000\n"
1292 s .= " if $I0 goto end\n"
1293 s .= " print n\n"
1294 s .= " print \"\\n\"\n"
1295 s .= " end:\n"
1296 s .= ".end\n"
1297 $P0 = compreg "PIR"
1298 $P0(s)
1299 outer = get_global ["XYZ"], "outer"
1300 $I1 = 0
1301 loop:
1302 inc $I1
1303 if $I1 > 10000 goto end
1304 outer($I1)
1305 goto loop
1306 end:
1307 .end
1308 CODE
1309 1000
1310 2000
1311 3000
1312 4000
1313 5000
1314 6000
1315 7000
1316 8000
1317 9000
1318 10000
1319 OUTPUT
1321 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall - overlapping Ix" );
1322 .sub main :main
1323 ($I0, $I1) = foo()
1324 print $I0
1325 print $I1
1326 print "\n"
1327 .end
1328 .sub foo
1329 .const .Sub b = "bar"
1330 I0 = 10
1331 I1 = 20
1332 set_args "0,0", I1, I0
1333 tailcall b
1334 .end
1335 .sub bar
1336 get_params "0,0", I0, I1
1337 .return (I0, I1)
1338 .end
1339 CODE
1340 2010
1341 OUTPUT
1343 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall - optional not set" );
1344 .sub main :main
1345 foo()
1346 print "ok\n"
1347 .end
1348 .sub foo
1349 .const .Sub b = "bar"
1350 .return b(10, 20)
1351 .end
1352 .sub bar
1353 .param int a
1354 .param int b
1355 .param int c :optional
1356 .param int has_c :opt_flag
1357 print a
1358 print ' '
1359 print b
1360 print ' '
1361 unless has_c goto no_c
1362 print c
1363 goto got_c
1364 no_c:
1365 print 'no'
1366 got_c:
1367 print "\n"
1368 .end
1369 CODE
1370 10 20 no
1371 ok
1372 OUTPUT
1374 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall - optional set" );
1375 .sub main :main
1376 foo()
1377 print "ok\n"
1378 .end
1379 .sub foo
1380 .const .Sub b = "bar"
1381 .return b(10, 20, 30)
1382 .end
1383 .sub bar
1384 .param int a
1385 .param int b
1386 .param int c :optional
1387 .param int has_c :opt_flag
1388 print a
1389 print ' '
1390 print b
1391 print ' '
1392 unless has_c goto no_c
1393 print c
1394 goto got_c
1395 no_c:
1396 print 'no'
1397 got_c:
1398 print "\n"
1399 .end
1400 CODE
1401 10 20 30
1402 ok
1403 OUTPUT
1405 pir_output_is( <<'CODE', <<'OUTPUT', "clone_key_arg" );
1406 .sub main :main
1407 foo()
1408 print "ok\n"
1409 .end
1411 .sub foo
1412 .local pmc cl, o
1413 cl = newclass "MyClass"
1414 o = new "MyClass"
1415 $S0 = "key"
1416 $I0 = 3
1417 o[$S0;$I0] = 42
1418 .end
1420 .namespace ["MyClass"]
1422 # key arguments in register have to be expanded into their
1423 # values because in the called sub frame the original refered
1424 # registers just don't exist #' for vim
1426 .sub set_integer_keyed :vtable :method
1427 .param pmc key
1428 .param int val
1429 print key # print first key
1430 print ' '
1431 key = shift key # get next key
1432 print key
1433 print ' '
1434 print val
1435 print "\n"
1436 .end
1437 CODE
1438 key 3 42
1439 ok
1440 OUTPUT
1442 # result_info op
1444 pir_output_is( <<'CODE', <<'OUTPUT', "result_info op" );
1445 .sub main :main
1446 test()
1447 $I0 = test()
1448 ($I1, $I2, $I3) = test()
1449 .end
1451 .sub test
1452 $P0 = result_info
1453 $I0 = elements $P0
1454 print $I0
1455 print "\n"
1456 .return (0)
1457 .end
1458 CODE
1459 0
1460 1
1461 3
1462 OUTPUT
1464 pir_output_is( <<'CODE', <<'OUTPUT', "result_info op with eval" );
1465 .sub main :main
1466 $S0 = <<"TESTSUB"
1467 .sub test
1468 $P0 = result_info
1469 $I0 = elements $P0
1470 print $I0
1471 print "\\n"
1472 .end
1473 TESTSUB
1474 $P0 = compreg "PIR"
1475 $P1 = $P0($S0)
1476 test()
1477 $I0 = test()
1478 ($I1, $I2, $I3) = test()
1479 .end
1480 CODE
1481 0
1482 1
1483 3
1484 OUTPUT
1486 pir_output_is( <<'CODE', <<'OUTPUT', ":slurpy result" );
1487 .sub main :main
1488 ($P0 :slurpy) = foo()
1489 $S0 = $P0[0]
1490 print $S0
1491 $S0 = $P0[1]
1492 print $S0
1493 .end
1494 .sub foo
1495 .return("ok 1\n", "ok 2\n")
1496 .end
1497 CODE
1498 ok 1
1499 ok 2
1500 OUTPUT
1502 pir_output_is( <<'CODE', <<'OUTPUT', ":optional result" );
1503 .sub main :main
1504 ($S0 :optional, $I1 :opt_flag) = foo()
1505 unless $I1 goto no_ret
1506 print "ok 1\n"
1507 print $S0
1508 end
1509 no_ret:
1510 print "not ok 1\n"
1511 .end
1512 .sub foo
1513 .return("ok 2\n")
1514 .end
1515 CODE
1516 ok 1
1517 ok 2
1518 OUTPUT
1520 pir_output_is( <<'CODE', <<'OUTPUT', ":optional result" );
1521 .sub main :main
1522 ($S0 :optional, $I1 :opt_flag) = foo()
1523 if $I1 goto has_ret
1524 print "ok 1\n"
1525 end
1526 has_ret:
1527 print "not ok 1\n"
1528 .end
1529 .sub foo
1530 .return()
1531 .end
1532 CODE
1533 ok 1
1534 OUTPUT
1536 pir_output_is( <<'CODE', <<'OUTPUT', "set_args via continuation -> results" );
1537 .sub main :main
1538 .local string result
1539 result = foo("ok 1\n")
1540 print result
1541 .end
1543 .sub foo
1544 .param string s
1545 .local pmc cc
1546 .include 'interpinfo.pasm'
1547 cc = interpinfo .INTERPINFO_CURRENT_CONT
1548 bar(cc, s)
1549 .end
1551 .sub bar
1552 .param pmc cc
1553 .param string s
1554 print s
1555 cc("ok 2\n")
1556 .end
1557 CODE
1558 ok 1
1559 ok 2
1560 OUTPUT
1562 pir_output_is( <<'CODE', <<'OUTPUT', "set_args via explicit continuation" );
1563 .sub main :main
1564 .local string result
1565 result = "not ok 2\n"
1566 .local pmc cont
1567 cont = new 'Continuation'
1568 set_addr cont, cont_dest
1569 bar(cont, "ok 1\n")
1570 print "oops\n"
1571 cont_dest:
1572 .get_results (result)
1573 print result
1574 .end
1576 .sub bar
1577 .param pmc cc
1578 .param string s
1579 print s
1580 cc("ok 2\n")
1581 .end
1582 CODE
1583 ok 1
1584 ok 2
1585 OUTPUT
1587 # this is a regression test for a bug in which tail-calling without set_args
1588 # used the args of the sub.
1589 pir_output_is( <<'CODE', <<'OUTPUT', "tailcall explicit continuation, no args" );
1590 .sub main :main
1591 .local string result
1592 result = "not ok 2\n"
1593 .local pmc cont
1594 cont = new 'Continuation'
1595 set_addr cont, cont_dest
1596 bar(cont, "ok 1\n")
1597 print "oops\n"
1598 cont_dest:
1599 print "ok 2\n"
1600 .end
1602 .sub bar
1603 .param pmc cc
1604 .param string s
1605 print s
1606 .return cc()
1607 .end
1608 CODE
1609 ok 1
1610 ok 2
1611 OUTPUT
1613 pir_output_is( <<'CODE', <<'OUTPUT', "newclosure followed by tailcall" );
1614 ## regression test for newclosure followed by tailcall, which used to recycle
1615 ## the context too soon. it looks awful because (a) the original version was
1616 ## produced by a compiler, and (b) in order to detect regression, we must force
1617 ## parrot to reuse the context, which seems to requires having other calls that
1618 ## use particular numbers of registers (and probably a fair amount of luck).
1619 .sub _main :main
1620 ## debug 0x80
1621 .lex "MAIN-CONT", $P41
1622 $I42 = 10
1623 $P41 = new 'Continuation'
1624 set_addr $P41, L2
1625 goto L3
1626 L2:
1627 get_results '0', $P45
1628 print "got "
1629 print $P45
1630 print ".\n"
1631 .return ()
1632 L3:
1633 .const .Sub $P49 = "___internal_main_test_"
1634 newclosure $P48, $P49
1635 .return _try_it($I42, $P48)
1636 .end
1638 .sub ___internal_main_test_ :outer('_main')
1639 .param pmc arg1
1640 print "[in test]\n"
1641 find_lex $P41, "MAIN-CONT"
1642 $P55 = new "Undef"
1643 if arg1 != 3 goto L3
1644 $P58 = arg1
1645 $P59 = arg1
1646 $P57 = n_mul $P58, $P59
1647 set_args '(0)', $P57
1648 tailcall $P41
1649 L3:
1650 print "not "
1651 print arg1
1652 print "\n"
1653 .end
1656 .sub _try_it
1657 .param int n
1658 .param pmc closure
1659 $P42 = new "Undef"
1660 $P42 = 0
1661 goto L4
1662 L2:
1663 closure($P42)
1664 $P42 = $P42 + 1
1665 L4:
1666 if $P42 < n goto L2
1667 .end
1668 CODE
1669 [in test]
1670 not 0
1671 [in test]
1672 not 1
1673 [in test]
1674 not 2
1675 [in test]
1676 got 9.
1677 OUTPUT
1679 pir_output_is( <<'CODE', <<'OUTPUT', "call evaled vtable code" );
1680 .sub main :main
1681 .local string s
1682 .local pmc cl, o
1683 cl = newclass "Foo"
1684 s = <<"END_PIR"
1685 .namespace ['Foo']
1686 .sub get_integer_keyed_int :vtable :method
1687 .param int i
1688 i += 5
1689 .return(i)
1690 .end
1691 END_PIR
1692 .local pmc comp
1693 comp = compreg "PIR"
1694 $P0 = comp(s)
1695 o = new 'Foo'
1696 $I0 = o[12]
1697 print $I0
1698 print "\n"
1699 .end
1700 CODE
1701 17
1702 OUTPUT
1704 pasm_output_is( <<'CODE', <<'OUTPUT', "named - 1" );
1705 .pcc_sub main:
1706 set_args "0x200, 0, 0x200, 0", "b", 10, "a", 20
1707 get_results ""
1708 find_name P1, "foo"
1709 invokecc P1
1710 print "ok\n"
1711 end
1712 .pcc_sub foo:
1713 get_params "0x200, 0, 0x200, 0", "a", I0, "b", I1
1714 print I1
1715 print ' '
1716 print I0
1717 print "\n"
1718 returncc
1719 CODE
1720 10 20
1721 ok
1722 OUTPUT
1724 pasm_output_is( <<'CODE', <<'OUTPUT', "named - 2 flatten" );
1725 .pcc_sub main:
1726 new P0, 'Hash'
1727 set P0['a'], 20
1728 set P0['b'], 10
1729 set_args "0x220", P0 # :flatten :named
1730 get_results ""
1731 find_name P1, "foo"
1732 invokecc P1
1733 print "ok\n"
1734 end
1735 .pcc_sub foo:
1736 get_params "0x200, 0, 0x200, 0", "a", I0, "b", I1
1737 print I1
1738 print ' '
1739 print I0
1740 print "\n"
1741 returncc
1742 CODE
1743 10 20
1744 ok
1745 OUTPUT
1747 pasm_output_is( <<'CODE', <<'OUTPUT', "named - 3 slurpy hash" );
1748 .pcc_sub main:
1749 set_args "0x200, 0, 0x200, 0,0x200, 0", "a", 10, "b", 20, 'c', 30
1750 get_results ""
1751 find_name P1, "foo"
1752 invokecc P1
1753 print "ok\n"
1754 end
1755 .pcc_sub foo:
1756 get_params "0x200, 0, 0x220", "a", I0, P0
1757 print I0
1758 print ' '
1759 elements I1, P0
1760 print I1
1761 print ' '
1762 typeof S0, P0
1763 print S0
1764 print ' '
1765 set I2, P0['b']
1766 print I2
1767 print ' '
1768 set I2, P0['c']
1769 print I2
1770 print "\n"
1771 returncc
1773 CODE
1774 10 2 Hash 20 30
1775 ok
1776 OUTPUT
1778 pasm_output_is( <<'CODE', <<'OUTPUT', "named - 4 positional -> named" );
1779 .pcc_sub main:
1780 set_args "0, 0, 0", 10, 20, 30
1781 get_results ""
1782 find_name P1, "foo"
1783 invokecc P1
1784 print "ok\n"
1785 end
1786 .pcc_sub foo:
1787 get_params "0x200, 0, 0x200, 0, 0x200, 0", "a", I0, "b", I1, 'c', I2
1788 print I0
1789 print ' '
1790 print I1
1791 print ' '
1792 print I2
1793 print "\n"
1794 returncc
1795 CODE
1796 10 20 30
1797 ok
1798 OUTPUT
1800 pasm_output_is( <<'CODE', <<'OUTPUT', "named - 5 slurpy array -> named" );
1801 .pcc_sub main:
1802 set_args "0, 0, 0, 0x200, 0, 0x200, 0", 10, 20, 30, 'a', 40, 'b', 50
1803 get_results ""
1804 find_name P1, "foo"
1805 invokecc P1
1806 print "ok\n"
1807 end
1808 .pcc_sub foo:
1809 get_params "0, 0x20, 0x200, 0, 0x200, 0", I0, P0, "b", I1, "a", I2
1810 print I0
1811 print ' '
1812 set I0, P0[0]
1813 print I0
1814 print ' '
1815 set I0, P0[1]
1816 print I0
1817 print ' '
1818 print I1
1819 print ' '
1820 print I2
1821 print "\n"
1822 returncc
1823 CODE
1824 10 20 30 50 40
1825 ok
1826 OUTPUT
1828 pir_output_is( <<'CODE', <<'OUTPUT', ":optional followed by :slurpy (empty)" );
1829 .sub main :main
1830 _write_thing(3)
1831 .end
1832 .sub _write_thing
1833 .param pmc arg1 :optional
1834 .param pmc rest_arg :slurpy
1835 print arg1
1836 print ' '
1837 print rest_arg
1838 print "\n"
1839 .end
1840 CODE
1841 3 0
1842 OUTPUT
1844 pir_output_is( <<'CODE', <<'OUTPUT', ":optional followed by :slurpy (used)" );
1845 .sub main :main
1846 _write_thing(3, 4, 5)
1847 .end
1848 .sub _write_thing
1849 .param pmc arg1 :optional
1850 .param pmc rest_arg :slurpy
1851 print arg1
1852 print ' '
1853 print rest_arg
1854 print "\n"
1855 .end
1856 CODE
1857 3 2
1858 OUTPUT
1860 ## Named
1861 pir_output_is( <<'CODE', <<'OUTPUT', ":named(\"...\") syntax for .param and sub call" );
1862 .sub main :main
1863 foo( 10 :named("b"), 20 :named("a"))
1864 print "ok\n"
1865 end
1866 .end
1868 .sub foo
1869 .param int c :named("a")
1870 .param int d :named("b")
1872 print d
1873 print ' '
1874 print c
1875 print "\n"
1876 .return()
1877 .end
1878 CODE
1879 10 20
1880 ok
1881 OUTPUT
1883 ## Named
1884 pir_output_is( <<'CODE', <<'OUTPUT', ":named(\"...\") syntax for the 4 kind" );
1885 .sub main :main
1886 ($I0 :named("b"), $I1 :named("a")) = foo( 10 :named("b"), 20 :named("a"))
1887 print $I0
1888 print ' '
1889 print $I1
1890 print "\n"
1891 print "ok\n"
1893 end
1894 .end
1896 .sub foo
1897 .param int c :named("a")
1898 .param int d :named("b")
1900 print d
1901 print ' '
1902 print c
1903 print "\n"
1905 .return ( 10 :named("a"), 20 :named("b"))
1906 .end
1907 CODE
1908 10 20
1909 20 10
1910 ok
1911 OUTPUT
1913 ## Named
1914 pir_output_is( <<'CODE', <<'OUTPUT', " 'foo' => 10 syntax for function call" );
1915 .sub main :main
1916 foo ('a'=>20,'b'=>10)
1917 print "ok\n"
1919 end
1920 .end
1922 .sub foo
1923 .param int c :named("a")
1924 .param int d :named("b")
1926 print d
1927 print ' '
1928 print c
1929 print "\n"
1931 .return ()
1932 .end
1933 CODE
1934 10 20
1935 ok
1936 OUTPUT
1938 ## Named
1939 pir_output_is( <<'CODE', <<'OUTPUT', " 'foo' => d syntax for parameters" );
1940 .sub main :main
1941 foo ('a'=>20,'b'=>10)
1942 print "ok\n"
1944 end
1945 .end
1947 .sub foo
1948 .param int "b" => d
1949 .param int "a" => c
1951 print d
1952 print ' '
1953 print c
1954 print "\n"
1956 .return ()
1957 .end
1958 CODE
1959 10 20
1960 ok
1961 OUTPUT
1963 ## Named
1964 pir_output_is( <<'CODE', <<'OUTPUT', " 'foo' => d syntax for target list" );
1965 .sub main :main
1966 ("b" => $I0 , "a" => $I1) = foo( "b" => 10 , "a" => 20)
1967 print $I0
1968 print ' '
1969 print $I1
1970 print "\n"
1971 print "ok\n"
1973 end
1974 .end
1976 .sub foo
1977 .param int "a" => c
1978 .param int "b" => d
1980 print d
1981 print ' '
1982 print c
1983 print "\n"
1985 .return ( 10 :named("a"), 20 :named("b"))
1986 .end
1987 CODE
1988 10 20
1989 20 10
1990 ok
1991 OUTPUT
1993 ## Named
1994 pir_output_is( <<'CODE', <<'OUTPUT', " 'foo' => d syntax for return" );
1995 .sub main :main
1996 ("b" => $I0 , "a" => $I1) = foo( "b" => 10 , "a" => 20)
1997 print $I0
1998 print ' '
1999 print $I1
2000 print "\n"
2001 print "ok\n"
2003 end
2004 .end
2006 .sub foo
2007 .param int "a" => c
2008 .param int "b" => d
2010 print d
2011 print ' '
2012 print c
2013 print "\n"
2015 .return ( "a" => 10, "b" => 20 )
2016 .end
2017 CODE
2018 10 20
2019 20 10
2020 ok
2021 OUTPUT
2023 pir_error_output_like( <<'CODE', <<'OUTPUT', "named => pos passing" );
2024 .sub main :main
2025 foo( "b" => 10 , "a" => 20)
2026 print "never\n"
2027 end
2028 .end
2030 .sub foo
2031 .param int a
2032 .param int b
2033 .end
2034 CODE
2035 /many named arguments/
2036 OUTPUT
2038 pir_output_is( <<'CODE', <<'OUTPUT', "named optional - set" );
2039 .sub main :main
2040 foo ('a'=>20,'b'=>10)
2041 print "ok\n"
2042 .end
2044 .sub foo
2045 .param int d :named('b')
2046 .param int c :named('a') :optional
2047 print d
2048 print ' '
2049 print c
2050 print "\n"
2051 .end
2052 CODE
2053 10 20
2054 ok
2055 OUTPUT
2057 pir_output_is( <<'CODE', <<'OUTPUT', "named optional - set" );
2058 .sub main :main
2059 foo ('a'=>20,'b'=>10)
2060 print "ok\n"
2061 .end
2063 .sub foo
2064 .param int 'b' => d
2065 .param int 'a' => c :optional
2066 print d
2067 print ' '
2068 print c
2069 print "\n"
2070 .end
2071 CODE
2072 10 20
2073 ok
2074 OUTPUT
2076 pir_output_is( <<'CODE', <<'OUTPUT', "named optional - set, :opt_flag" );
2077 .sub main :main
2078 foo ('a'=>20,'b'=>10)
2079 print "ok\n"
2080 .end
2082 .sub foo
2083 .param int d :named('b') :optional
2084 .param int has_d :opt_flag
2085 .param int c :named('a') :optional
2086 .param int has_c :opt_flag
2087 print d
2088 print ' '
2089 print has_d
2090 print ' '
2091 print c
2092 print ' '
2093 print has_c
2094 print "\n"
2095 .end
2096 CODE
2097 10 1 20 1
2098 ok
2099 OUTPUT
2101 pir_output_is( <<'CODE', <<'OUTPUT', "named optional - mix" );
2102 .sub main :main
2103 foo ('a'=>20,'b'=>10)
2104 foo ('b'=>10)
2105 foo ('a'=>20)
2106 foo ()
2107 print "ok\n"
2108 .end
2110 .sub foo
2111 .param int d :named('b') :optional
2112 .param int has_d :opt_flag
2113 .param int c :named('a') :optional
2114 .param int has_c :opt_flag
2115 print d
2116 print ' '
2117 print has_d
2118 print ' '
2119 print c
2120 print ' '
2121 print has_c
2122 print "\n"
2123 .end
2124 CODE
2125 10 1 20 1
2126 10 1 0 0
2127 0 0 20 1
2128 0 0 0 0
2129 ok
2130 OUTPUT
2132 pir_output_is( <<'CODE', <<'OUTPUT', "named flat/slurpy" );
2133 .sub main :main
2134 .local pmc h
2135 h = new 'Hash'
2136 h['a'] = 20
2137 h['b'] = 10
2138 foo( h :named :flat )
2139 print "ok\n"
2140 end
2141 .end
2143 .sub foo
2144 .param pmc h :named :slurpy
2145 $I0 = h['a']
2146 $I1 = h['b']
2147 print $I0
2148 print ' '
2149 print $I1
2150 print "\n"
2151 .end
2152 CODE
2153 20 10
2154 ok
2155 OUTPUT
2157 pir_error_output_like( <<'CODE', <<'OUTPUT', "param .. 'a' => v :named('foo')" );
2158 .sub main :main
2159 foo( "b" => 10, "a" => 20)
2160 print "never\n"
2161 end
2162 .end
2164 .sub foo
2165 .param int "a" => c :named("foo")
2166 .param int "b" => d
2167 .end
2168 CODE
2169 /Named parameter with more than one name/
2170 OUTPUT
2172 pir_error_output_like( <<'CODE', <<'OUTPUT', "param .. 'a' => v :named('foo')" );
2173 .sub main :main
2174 foo( "b" => 10, "a" => 20)
2175 print "never\n"
2176 end
2177 .end
2179 .sub foo
2180 .param int c :named("foo") :named("bar")
2181 .param int "b" => d
2182 .end
2183 CODE
2184 /Named parameter with more than one name/
2185 OUTPUT
2187 pir_output_is( <<'CODE', <<'OUTPUT', "default value for an unused :optional" );
2188 .sub main :main
2189 print 1
2190 foo(1)
2191 foo(2)
2192 foo()
2193 print "\n"
2194 .end
2195 .sub foo
2196 .param int var :optional
2197 print var
2198 .end
2199 CODE
2200 1120
2201 OUTPUT
2203 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch - missing named" );
2204 .sub main :main
2205 .include "errors.pasm"
2206 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
2207 foo ('b'=>10)
2208 print "ok\n"
2209 .end
2211 .sub foo
2212 .param int d :named('b')
2213 .param int c :named('a')
2214 print d
2215 print ' '
2216 print c
2217 print "\n"
2218 .end
2219 CODE
2220 /too few arguments/
2221 OUTPUT
2223 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch - missing named" );
2224 .sub main :main
2225 .include "errors.pasm"
2226 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
2227 foo ('a'=>10)
2228 print "ok\n"
2229 .end
2231 .sub foo
2232 .param int d :named('b')
2233 .param int c :named('a')
2234 print d
2235 print ' '
2236 print c
2237 print "\n"
2238 .end
2239 CODE
2240 /too few arguments/
2241 OUTPUT
2243 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch - too many named" );
2244 .sub main :main
2245 .include "errors.pasm"
2246 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
2247 foo ('a'=>10, 'b'=>20, 'c'=>30)
2248 print "ok\n"
2249 .end
2251 .sub foo
2252 .param int d :named('b')
2253 .param int c :named('a')
2254 print d
2255 print ' '
2256 print c
2257 print "\n"
2258 .end
2259 CODE
2260 /too many/
2261 OUTPUT
2263 pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch - duplicate named" );
2264 .sub main :main
2265 .include "errors.pasm"
2266 errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
2267 foo ('a'=>10, 'b'=>20, 'a'=>30)
2268 print "ok\n"
2269 .end
2271 .sub foo
2272 .param int d :named('b')
2273 .param int c :named('a')
2274 print d
2275 print ' '
2276 print c
2277 print "\n"
2278 .end
2279 CODE
2280 /duplicate name/
2281 OUTPUT
2283 pir_output_is( <<'CODE', <<'OUTPUT', "slurpy named after slurpy array" );
2284 .sub main :main
2285 foo(0, 'abc' => 1)
2286 foo('abc' => 2)
2287 $P0 = new 'ResizablePMCArray'
2288 push $P0, 1
2289 foo($P0 :flat, 'abc' => 3)
2290 $P0 = new 'ResizablePMCArray'
2291 foo($P0 :flat, 'abc' => 4)
2292 .end
2294 .sub foo
2295 .param pmc array :slurpy
2296 .param pmc hash :slurpy :named
2297 print "ok "
2298 $P0 = hash['abc']
2299 print $P0
2300 print "\n"
2301 .end
2302 CODE
2303 ok 1
2304 ok 2
2305 ok 3
2306 ok 4
2307 OUTPUT
2309 pir_output_is( <<'CODE', <<'OUTPUT', "slurpy named loses :flat arg (#39044)" );
2310 .sub main :main
2311 $P0 = new 'Hash'
2312 $P0['a'] = 11
2313 $P0['b'] = 22
2314 $P0['c'] = 33
2315 foo(0, 1, $P0 :flat :named)
2316 .end
2318 .sub foo
2319 .param pmc array :slurpy
2320 .param pmc hash :slurpy :named
2321 $I0 = elements array
2322 print $I0
2323 print "\n"
2324 $P0 = hash['a']
2325 say $P0
2326 $P0 = hash['b']
2327 say $P0
2328 $P0 = hash['c']
2329 say $P0
2330 .end
2331 CODE
2332 2
2333 11
2334 22
2335 33
2336 OUTPUT
2338 pir_output_is( <<'CODE', <<'OUTPUT', "slurpy named loses :flat arg" );
2339 .sub main :main
2340 $P0 = new 'Hash'
2341 $P0['a'] = 11
2342 $P0['b'] = 22
2343 $P0['c'] = 33
2344 foo(0, 1, 'z'=>2626, $P0 :flat :named)
2345 .end
2347 .sub foo
2348 .param pmc array :slurpy
2349 .param pmc hash :slurpy :named
2350 $P0 = hash['a']
2351 say $P0
2352 $P0 = hash['b']
2353 say $P0
2354 $P0 = hash['c']
2355 say $P0
2356 $P0 = hash['z']
2357 say $P0
2358 .end
2359 CODE
2360 11
2361 22
2362 33
2363 2626
2364 OUTPUT
2366 pir_error_output_like( <<'CODE', <<'OUTPUT', "unexpected positional arg" );
2367 .sub 'main'
2368 'foo'('abc', 'def', 'ghi'=>1)
2369 .end
2371 .sub 'foo'
2372 .param string name
2373 .param pmc args :slurpy :named
2374 .end
2375 CODE
2376 /positional inside named args at position 2/
2377 OUTPUT
2379 pir_error_output_like( <<'CODE', <<'OUTPUT', "unexpected positional arg" );
2380 .sub 'main'
2381 'foo'('abc', 'def'=>1, 'ghi', 'jkl'=>1)
2382 .end
2384 .sub 'foo'
2385 .param string name
2386 .param pmc args :slurpy :named
2387 .end
2388 CODE
2389 /positional inside named args at position 3/
2390 OUTPUT
2392 pir_output_is( <<'CODE', <<'OUTPUT', "RT #40490 - flat/slurpy named arguments" );
2393 .sub 'main' :main
2394 .local pmc args
2395 args = new 'Hash'
2396 args['foo'] = 1
2397 args['bar'] = 2
2399 bar_only( args :flat :named )
2400 .end
2402 .sub 'bar_only'
2403 .param string bar :named( 'bar' )
2404 .param pmc args :named :slurpy
2406 print "Have bar: "
2407 print bar
2408 print "\n"
2409 .end
2410 CODE
2411 Have bar: 2
2412 OUTPUT
2414 pir_output_is(
2415 <<'CODE', <<'OUTPUT', "Tail call without arguments should not free the context when a closure depends on it" );
2416 .sub main :main
2417 $P0 = create_closure_and_run_it()
2418 .end
2420 .sub create_closure_and_run_it
2421 P0 = new "Integer"
2422 P0 = 3
2423 .lex "val", P0
2424 P2 = get_global "myclosure"
2425 P1 = newclosure P2
2426 # There is a closure depending on our current context, so this shouldn't
2427 # free it.
2428 .return P1()
2429 .end
2431 .sub myclosure :outer(create_closure_and_run_it)
2432 P1 = find_lex "val"
2433 say P1
2434 donothing()
2435 P1 = find_lex "val"
2436 say P1
2437 .return ()
2438 .end
2440 .sub donothing
2441 P0 = new "Integer"
2442 P0 = 5
2443 # This creates a new binding that is not accessible by the
2444 # caller (myclosure)
2445 .lex "val", P0
2446 P2 = null
2447 P1 = null
2448 .end
2449 CODE
2450 3
2451 3
2452 OUTPUT
2454 pir_output_is( <<'CODE', <<'OUTPUT', "slurpy named after :optional" );
2455 .sub main :main
2456 foo(0, 'abc' => 1)
2457 foo('abc' => 2)
2458 $P0 = new 'ResizablePMCArray'
2459 push $P0, 1
2460 foo($P0 :flat, 'abc' => 3)
2461 $P0 = new 'ResizablePMCArray'
2462 foo($P0 :flat, 'abc' => 4)
2463 .end
2465 .sub foo
2466 .param pmc val :optional
2467 .param int has_val :opt_flag
2468 .param pmc hash :slurpy :named
2469 print "ok "
2470 $P0 = hash['abc']
2471 print $P0
2472 print "\n"
2473 .end
2474 CODE
2475 ok 1
2476 ok 2
2477 ok 3
2478 ok 4
2479 OUTPUT
2481 # Local Variables:
2482 # mode: cperl
2483 # cperl-indent-level: 4
2484 # fill-column: 100
2485 # End:
2486 # vim: expandtab shiftwidth=4: